DEFCMD.EL : no more interactive string specs

defcmd.el

;;; DEFCMD.EL : no more interactive string specs

(setq lexical-binding t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MODULE

(defun interactive-arg-map (l)
  (if (evenp (length l))
      (let* ((ps (-partition 2 l))
	     (params (mapcar #'car ps))
	     (specs (mapcar #'cadr ps)))
	(cons params specs))
    (error "%s should have even number of elements.")))

(defun to-spec (t)
  (cond ((eq t 'string          ) "sstring: ")
	((eq t 'buffer          ) "bbuffer: ")
	((eq t 'fun		) "a -- Function name: symbol with a function definition: ")
	;;	((eq t 'buffer	) "b -- Name of existing buffer: ")
	((eq t 'buffer?		) "B -- Name of buffer, possibly nonexistent: ")
	((eq t 'char		) "c -- Character (no input method is used): ")
	((eq t 'command		) "C -- Command name: symbol with interactive function definition: ")
	((eq t 'point		) "d -- Value of point as number.  Does not do I/O: ")
	((eq t 'dir		) "D -- Directory name: ")
	((eq t 'event		) "e -- Parameterized event (i.e., one that’s a list) that invoked this command: ")
	((eq t 'file		) "f -- Existing file name: ")
	((eq t 'file?		) "F -- Possibly nonexistent file name: ")
	((eq t 'file??		) "G -- Possibly nonexistent file name, defaulting to just directory name: ")
	((eq t 'nop		) "i -- Ignored, i.e. always nil.  Does not do I/O: ")
	((eq t 'keys		) "k -- Key sequence (downcase the last event if needed to get a definition): ")
	((eq t 'keys!		) "K -- Key sequence to be redefined (do not downcase the last event): ")
	((eq t 'mark		) "m -- Value of mark as number.  Does not do I/O: ")
	((eq t 'str*		) "M -- Any string.  Inherits the current input method: ")
	((eq t 'num		) "n -- Number read using minibuffer: ")
	((eq t 'prefix-arg	) "N -- Numeric prefix arg, or if none, do like code ‘n’: ")
	((eq t 'prefix-num	) "p -- Prefix arg converted to number.  Does not do I/O: ")
	((eq t 'prefix-raw	) "P -- Prefix arg in raw form.  Does not do I/O: ")
	((eq t 'region		) "r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O: ")
	;;	((eq t 'string	) "s -- Any string.  Does not inherit the current input method: ")
	((eq t 'symbol		) "S -- Any symbol: ")
	((eq t 'mouse-even	) "U -- Mouse up event discarded by a previous k or K argument: ")
	((eq t 'var		) "v -- Variable name: symbol that is ‘custom-variable-p’: ")
	((eq t '-sexp		) "x -- Lisp expression read but not evaluated: ")
	((eq t 'sexp		) "X -- Lisp expression read and evaluated: ")
	((eq t 'coding		) "z -- Coding system: ")
	((eq t 'coding?		) "Z -- Coding system, nil if no prefix arg: ")
	(t nil)))

(defmacro defcmd (command args &rest body)
  (let* ((map (interactive-arg-map args))
	 (args (car map))
	 (specs (cdr map)))
    `(defun ,command ,args
       (interactive ,(mapconcat #'to-spec specs "\n"))
       ,@body)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TEST

(interactive-arg-map '(a string b buffer c char d num e sexp f file))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; EXAMPLE

(defcmd foobar (a string b buffer c char d num e sexp f file)
  (message ">>> %s" (list a b c d e f)))