CLIM mail archive
[Prev][Next][Index][Thread]

Menu item inheritance in command tables

    Date: Mon, 20 Jul 1992 15:26 EDT
    From: Randy Coulman <coulman@skdad.usask.ca>


    I am implementing a system which has two layouts.  The two layouts have some
    commands in common, but others are different.  So, I've defined separate 
    command tables for the two.  I then defined a parent command table that 
    contains the common commands and the other two command tables inherit from this
    parent command table.  So far, so good.

    The problem is that the menus for the two interfaces do not display the items
    from the parent command table.  I searched back in my archives of this list and
    found this subject discussed before.  It seems that an implementation decision
    was made that menu items should not be inherited in command tables, because
    the implementers felt that this was wrong for most cases.  This may be true, 
    but for my case, it is not wrong.  

    I can solve the problem by using add-menu-item-to-command-table to add menu
    items to the child command tables for each common command.  Since my 
    requirements are quite simple, this isn't to bad.  However, if someone had 
    many levels of inheritance or many inherited commands, this technique would 
    soon grow quite unwieldy.

    Would it be possible/desirable to add a keyword argument somewhere to allow 
    this type of functionality?  Something along the lines of the :inherited 
    keyword to map-over-command-table-commands would do nicely.

    Any comments?  Also, does anyone have a better approach?  I considered 
    defining two different versions of the common commands, but decided against it.
    It wouldn't be too hard to return to that technique, if someone has convincing
    arguments that things should be done that way.

I will implement an :INHERIT-MENU option for CLIM 2.0, since this has been
requested so many times.  The following will do the trick in CLIM 1.1, but
this will not necessarily be exactly what will appear in CLIM 2.0.

----------------
(in-package :clim)

(defun make-command-table (name &key inherit-from menu inherit-menu (errorp t))
  (check-type name symbol)
  (check-type inherit-from list)
  (let ((command-table (find-command-table name :errorp nil)))
    (when command-table
      (ecase errorp
	((t)
	 (cerror "Remove the command table and proceed"
		 'command-table-already-exists
		 :format-string "Command table ~S already exists"
		 :format-args (list name))
	 (remhash name *all-command-tables*))
	((nil)
	 (remhash name *all-command-tables*))))
    (setq command-table (make-instance 'standard-command-table
			  :name name
			  :inherit-from inherit-from))
    (process-command-table-menu command-table menu inherit-menu)
    (setf (gethash name *all-command-tables*) command-table)
    command-table))

(defun process-command-table-menu (command-table menu inherit-menu)
  (check-type menu list)
  (check-type inherit-menu boolean)
  (when inherit-menu
    (dolist (comtab (command-table-inherit-from command-table))
      (let* ((comtab (find-command-table comtab :errorp nil))
	     (menu (and comtab (slot-value comtab 'menu))))
	(when menu
	  (dovector (element menu)
	    (destructuring-bind (string keystroke (type value &rest options)) element
	      (apply #'add-menu-item-to-command-table 
		     command-table string type value
		     :keystroke keystroke :errorp nil
		     options)))))))
  (dolist (item menu)
    (let* ((string (pop item))
	   (type (pop item))
	   (value (pop item))
	   (options item))
      (apply #'add-menu-item-to-command-table
	     command-table string type value
	     :errorp nil
	     options))))

(defmacro define-command-table (name &key inherit-from (menu nil menu-p) inherit-menu)
  #+Genera (declare (zwei:indentation 1 1))
  (setf (compile-time-property name 'command-table-name) t)
  `(define-command-table-1 ',name 
			   :inherit-from ',inherit-from 
			   ,@(and menu-p `(:menu ',menu))
			   :inherit-menu ,inherit-menu))

(defun define-command-table-1 (name &key inherit-from (menu nil menu-p) inherit-menu)
  (check-type name symbol)
  (check-type inherit-from list)
  (when (null inherit-from)
    (setq inherit-from (list (command-table-name *global-command-table*))))
  (let ((old-command-table (find-command-table name :errorp nil)))
    (cond (old-command-table
	   (setf (command-table-inherit-from old-command-table) inherit-from)
	   (when menu-p
	     ;; Only discard the old menu if a new one was explicitly
	     ;; supplied.  This keeps us from throwing away menu items
	     ;; that the user asked for via :MENU to DEFINE-COMMAND.
	     (setf (slot-value old-command-table 'menu) nil))
	   (process-command-table-menu old-command-table menu inherit-menu)
	   (setf (slot-value old-command-table 'keystrokes) nil)
	   old-command-table)
	  (t
	   (make-command-table name :inherit-from inherit-from 
				    :menu menu :inherit-menu inherit-menu)))))
References:
Main Index | Thread Index