src/container.lisp

   1 ;;; container.lisp --- Container management
   2
   3 ;; Copyright (C) 2010, 2011 Didier Verna
   4
   5 ;; Author:        Didier Verna <didier@lrde.epita.fr>
   6 ;; Maintainer:    Didier Verna <didier@lrde.epita.fr>
   7
   8 ;; This file is part of Clon.
   9
  10 ;; Permission to use, copy, modify, and distribute this software for any
  11 ;; purpose with or without fee is hereby granted, provided that the above
  12 ;; copyright notice and this permission notice appear in all copies.
  13
  14 ;; THIS SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  15 ;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  16 ;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  17 ;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  18 ;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  19 ;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  20 ;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  21
  22
  23 ;;; Commentary:
  24
  25 ;; Contents management by FCM version 0.1.
  26
  27
  28 ;;; Code:
  29
  30 (in-package :com.dvlsoft.clon)
  31 (in-readtable :com.dvlsoft.clon)
  32
  33
  34 ;; ==========================================================================
  35 ;; The Container Class
  36 ;; ==========================================================================
  37
  38 (defabstract container (item)
  39   ((items :documentation "The items in the container."
  40           :type list
  41           :initform nil
  42           :initarg :items
  43           :reader items))
  44   (:documentation "The CONTAINER class.
  45 This class is a mixin used in synopsis and groups to represent the program's
  46 command-line hierarchy."))
  47
  48
  49 ;; ------------------
  50 ;; Traversal protocol
  51 ;; ------------------
  52
  53 (defmethod untraverse ((container container))
  54   "Untraverse all CONTAINER items."
  55   (dolist (item (items container))
  56     (untraverse item))
  57   container)
  58
  59
  60 ;; -------------------------
  61 ;; Name clash check protocol
  62 ;; -------------------------
  63
  64 (defmethod check-name-clash ((container container) item2)
  65   "Check for name clash between CONTAINER's options and ITEM2's ones."
  66   (dolist (item1 (items container))
  67     (check-name-clash item1 item2)))
  68
  69 (defmethod check-name-clash (item1 (container container))
  70   "Check for name clash between ITEM1's options and CONTAINER's ones."
  71   (dolist (item2 (items container))
  72     (check-name-clash item1 item2)))
  73
  74 (defmethod check-name-clash ((container1 container) (container2 container))
  75   "Check for name clash between CONTAINER1's options and CONTAINER2's ones."
  76   (dolist (item1 (items container1))
  77     (dolist (item2 (items container2))
  78       (check-name-clash item1 item2))))
  79
  80
  81 ;; -------------------------
  82 ;; Help specifation protocol
  83 ;; -------------------------
  84
  85 (defmethod help-spec ((container container) &key)
  86   "Return CONTAINER's help specification."
  87   (loop :for item :in (items container)
  88         :when (help-spec item)
  89           :collect :it))
  90
  91
  92
  93 ;; ==========================================================================
  94 ;; Container Instance Creation
  95 ;; ==========================================================================
  96
  97 (defmethod initialize-instance :around
  98     ((container container) &rest keys &key item)
  99   "Canonicalize initialization arguments.
 100 This involves:
 101 - computing the :items initarg from the :item ones."
 102   (declare (ignore item))
 103   (apply #'call-next-method container
 104          :items (remove :item (select-keys keys :item))
 105          (remove-keys keys :item)))
 106
 107 (defmethod initialize-instance :after ((container container) &key)
 108   "Perform name clash check on CONTAINER's items."
 109   (loop :for items :on (items container)
 110         :while (cdr items)
 111         :do (loop :for item2 in (cdr items)
 112                   :do (check-name-clash (car items) item2))))
 113
 114
 115 ;;; container.lisp ends here