[bpt/emacs.git] / lisp / eshell / esh-opt.el

;;; esh-opt.el --- command options processing

;; Copyright (C) 1999-2013 Free Software Foundation, Inc.

;; Author: John Wiegley <johnw@gnu.org>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(provide 'esh-opt)

(require 'esh-ext)

;; Unused.
;; (defgroup eshell-opt nil
;;   "The options processing code handles command argument parsing for
;; Eshell commands implemented in Lisp."
;;   :tag "Command options processing"
;;   :group 'eshell)

;;; User Functions:

(defmacro eshell-eval-using-options (name macro-args options &rest body-forms)
  "Process NAME's MACRO-ARGS using a set of command line OPTIONS.
After doing so, stores settings in local symbols as declared by OPTIONS;
then evaluates BODY-FORMS -- assuming all was OK.

OPTIONS is a list, beginning with one or more elements of the form:
\(SHORT LONG VALUE SYMBOL HELP-STRING)
Each of these elements represents a particular command-line switch.

SHORT is either nil, or a character that can be used as a switch -SHORT.
LONG is either nil, or a string that can be used as a switch --LONG.
At least one of SHORT and LONG must be non-nil.
VALUE is the value associated with the option.  It can be either:
  t   - the option needs a value to be specified after the switch;
  nil - the option is given the value t;
  anything else - specifies the actual value for the option.
SYMBOL is either nil, or the name of the Lisp symbol that will be bound
to VALUE.  A nil SYMBOL calls `eshell-show-usage', and so is appropriate
for a \"--help\" type option.
HELP-STRING is a documentation string for the option.

Any remaining elements of OPTIONS are :KEYWORD arguments.  Some take
arguments, some do not.  The recognized :KEYWORDS are:

:external STRING
  STRING is an external command to run if there are unknown switches.

:usage STRING
  STRING is the initial part of the command's documentation string.
  It appears before the options are listed.

:post-usage STRING
  STRING is an optional trailing part of the command's documentation string.
  It appears after the options, but before the final part of the
  documentation about the associated external command (if there is one).

:show-usage
  If present, then show the usage message if the command is called with no
  arguments.

:preserve-args
  If present, do not pass MACRO-ARGS through `eshell-flatten-list'
and `eshell-stringify-list'.

For example, OPTIONS might look like:

  '((?C  nil         nil multi-column    \"multi-column display\")
    (nil \"help\"      nil nil             \"show this usage display\")
    (?r  \"reverse\"   nil reverse-list    \"reverse order while sorting\")
    :external \"ls\"
    :usage \"[OPTION]... [FILE]...
  List information about the FILEs (the current directory by default).
  Sort entries alphabetically across.\")

`eshell-eval-using-options' returns the value of the last form in
BODY-FORMS.  If instead an external command is run (because of
an unknown option), the tag `eshell-external' will be thrown with
the new process for its value.

Lastly, any remaining arguments will be available in a locally
interned variable `args' (created using a `let' form)."
  (declare (debug (form form sexp body)))
  `(let ((temp-args
	  ,(if (memq ':preserve-args (cadr options))
	       macro-args
	     (list 'eshell-stringify-list
		   (list 'eshell-flatten-list macro-args)))))
     (let ,(delq nil (mapcar (lambda (opt)
				       (and (listp opt) (nth 3 opt)))
				     (cadr options)))
       ;; FIXME: `options' ends up hiding some variable names under `quote',
       ;; which is incompatible with lexical scoping!!
       (eshell-do-opt ,name ,options (lambda (args) ,@body-forms) temp-args))))

;;; Internal Functions:

;; Documented part of the interface; see eshell-eval-using-options.
(defvar eshell--args)

(defun eshell-do-opt (name options body-fun args)
  "Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
  (let* (last-value
         (ext-command
       (catch 'eshell-ext-command
            (let ((usage-msg
		(catch 'eshell-usage
		  (setq last-value nil)
		  (if (and (= (length args) 0)
			   (memq ':show-usage options))
		      (throw 'eshell-usage
			     (eshell-show-usage name options)))
		  (setq args (eshell-process-args name args options)
			last-value (funcall body-fun args))
                     nil)))
              (when usage-msg
                (error "%s" usage-msg))))))
    (if ext-command
      (throw 'eshell-external
             (eshell-external-command ext-command args))
      last-value)))

(defun eshell-show-usage (name options)
  "Display the usage message for NAME, using OPTIONS."
  (let ((usage (format "usage: %s %s\n\n" name
		       (cadr (memq ':usage options))))
	(extcmd (memq ':external options))
	(post-usage (memq ':post-usage options))
	had-option)
    (while options
      (when (listp (car options))
	(let ((opt (car options)))
	  (setq had-option t)
	  (cond ((and (nth 0 opt)
		      (nth 1 opt))
		 (setq usage
		       (concat usage
			       (format "    %-20s %s\n"
				       (format "-%c, --%s" (nth 0 opt)
					       (nth 1 opt))
				       (nth 4 opt)))))
		((nth 0 opt)
		 (setq usage
		       (concat usage
			       (format "    %-20s %s\n"
				       (format "-%c" (nth 0 opt))
				       (nth 4 opt)))))
		((nth 1 opt)
		 (setq usage
		       (concat usage
			       (format "    %-20s %s\n"
				       (format "    --%s" (nth 1 opt))
				       (nth 4 opt)))))
		(t (setq had-option nil)))))
      (setq options (cdr options)))
    (if post-usage
	(setq usage (concat usage (and had-option "\n")
			    (cadr post-usage))))
    (when extcmd
      (setq extcmd (eshell-search-path (cadr extcmd)))
      (if extcmd
	  (setq usage
		(concat usage
			(format "
This command is implemented in Lisp.  If an unrecognized option is
passed to this command, the external version '%s'
will be called instead." extcmd)))))
    (throw 'eshell-usage usage)))

(defun eshell-set-option (name ai opt options)
  "Using NAME's remaining args (index AI), set the OPT within OPTIONS.
If the option consumes an argument for its value, the argument list
will be modified."
  (if (not (nth 3 opt))
      (eshell-show-usage name options)
    (if (eq (nth 2 opt) t)
	(if (> ai (length eshell--args))
	    (error "%s: missing option argument" name)
	  (set (nth 3 opt) (nth ai eshell--args))
	  (if (> ai 0)
	      (setcdr (nthcdr (1- ai) eshell--args)
                      (nthcdr (1+ ai) eshell--args))
	    (setq eshell--args (cdr eshell--args))))
      (set (nth 3 opt) (or (nth 2 opt) t)))))

(defun eshell-process-option (name switch kind ai options)
  "For NAME, process SWITCH (of type KIND), from args at index AI.
The SWITCH will be looked up in the set of OPTIONS.

SWITCH should be either a string or character.  KIND should be the
integer 0 if it's a character, or 1 if it's a string.

The SWITCH is then be matched against OPTIONS.  If no matching handler
is found, and an :external command is defined (and available), it will
be called; otherwise, an error will be triggered to say that the
switch is unrecognized."
  (let* ((opts options)
	 found)
    (while opts
      (if (and (listp (car opts))
               (nth kind (car opts))
               (equal switch (nth kind (car opts))))
	  (progn
	    (eshell-set-option name ai (car opts) options)
	    (setq found t opts nil))
	(setq opts (cdr opts))))
    (unless found
      (let ((extcmd (memq ':external options)))
	(when extcmd
	  (setq extcmd (eshell-search-path (cadr extcmd)))
	  (if extcmd
	      (throw 'eshell-ext-command extcmd)
            (error (if (characterp switch) "%s: unrecognized option -%c"
                     "%s: unrecognized option --%s")
                   name switch)))))))

(defun eshell-process-args (name args options)
  "Process the given ARGS using OPTIONS.
This assumes that symbols have been intern'd by `eshell-eval-using-options'."
  (let ((ai 0) arg
        (eshell--args args))
    (while (< ai (length args))
      (setq arg (nth ai args))
      (if (not (and (stringp arg)
		    (string-match "^-\\(-\\)?\\(.*\\)" arg)))
	  (setq ai (1+ ai))
	(let* ((dash (match-string 1 arg))
	       (switch (match-string 2 arg)))
	  (if (= ai 0)
	      (setq args (cdr args))
	    (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)))
	  (if dash
	      (if (> (length switch) 0)
		  (eshell-process-option name switch 1 ai options)
		(setq ai (length args)))
	    (let ((len (length switch))
		  (index 0))
	      (while (< index len)
		(eshell-process-option name (aref switch index) 0 ai options)
		(setq index (1+ index)))))))))
  args)

;;; esh-opt.el ends here
Commit	Line	Data
60370d40	1	;;; esh-opt.el --- command options processing
affbf647	2
ab422c4d	3	;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
affbf647	4
7de5b421 GM	5	;; Author: John Wiegley <johnw@gnu.org>
7de5b421 GM	6
affbf647 GM	7	;; This file is part of GNU Emacs.
affbf647 GM	8
4ee57b2a	9	;; GNU Emacs is free software: you can redistribute it and/or modify
affbf647	10	;; it under the terms of the GNU General Public License as published by
4ee57b2a GM	11	;; the Free Software Foundation, either version 3 of the License, or
4ee57b2a GM	12	;; (at your option) any later version.
affbf647 GM	13
	14	;; GNU Emacs is distributed in the hope that it will be useful,
	15	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	16	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	;; GNU General Public License for more details.
	18
	19	;; You should have received a copy of the GNU General Public License
4ee57b2a	20	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
affbf647	21
4e6cc05c GM	22	;;; Commentary:
4e6cc05c GM	23
8c7309fe GM	24	;;; Code:
8c7309fe GM	25
affbf647 GM	26	(provide 'esh-opt)
affbf647 GM	27
f87b1284	28	(require 'esh-ext)
affbf647	29
ed8be7ff	30	;; Unused.
170266d0 SM	31	;; (defgroup eshell-opt nil
	32	;; "The options processing code handles command argument parsing for
	33	;; Eshell commands implemented in Lisp."
	34	;; :tag "Command options processing"
	35	;; :group 'eshell)
affbf647	36
affbf647 GM	37	;;; User Functions:
affbf647 GM	38
4e05e67e	39	(defmacro eshell-eval-using-options (name macro-args options &rest body-forms)
affbf647	40	"Process NAME's MACRO-ARGS using a set of command line OPTIONS.
4e05e67e GM	41	After doing so, stores settings in local symbols as declared by OPTIONS;
4e05e67e GM	42	then evaluates BODY-FORMS -- assuming all was OK.
affbf647	43
4e05e67e GM	44	OPTIONS is a list, beginning with one or more elements of the form:
	45	\(SHORT LONG VALUE SYMBOL HELP-STRING)
	46	Each of these elements represents a particular command-line switch.
	47
	48	SHORT is either nil, or a character that can be used as a switch -SHORT.
	49	LONG is either nil, or a string that can be used as a switch --LONG.
	50	At least one of SHORT and LONG must be non-nil.
	51	VALUE is the value associated with the option. It can be either:
	52	t - the option needs a value to be specified after the switch;
	53	nil - the option is given the value t;
	54	anything else - specifies the actual value for the option.
	55	SYMBOL is either nil, or the name of the Lisp symbol that will be bound
	56	to VALUE. A nil SYMBOL calls `eshell-show-usage', and so is appropriate
	57	for a \"--help\" type option.
	58	HELP-STRING is a documentation string for the option.
	59
	60	Any remaining elements of OPTIONS are :KEYWORD arguments. Some take
	61	arguments, some do not. The recognized :KEYWORDS are:
	62
	63	:external STRING
	64	STRING is an external command to run if there are unknown switches.
	65
	66	:usage STRING
	67	STRING is the initial part of the command's documentation string.
	68	It appears before the options are listed.
	69
	70	:post-usage STRING
	71	STRING is an optional trailing part of the command's documentation string.
	72	It appears after the options, but before the final part of the
	73	documentation about the associated external command (if there is one).
	74
	75	:show-usage
	76	If present, then show the usage message if the command is called with no
	77	arguments.
	78
	79	:preserve-args
	80	If present, do not pass MACRO-ARGS through `eshell-flatten-list'
	81	and `eshell-stringify-list'.
	82
	83	For example, OPTIONS might look like:
affbf647 GM	84
	85	'((?C nil nil multi-column \"multi-column display\")
	86	(nil \"help\" nil nil \"show this usage display\")
	87	(?r \"reverse\" nil reverse-list \"reverse order while sorting\")
	88	:external \"ls\"
	89	:usage \"[OPTION]... [FILE]...
	90	List information about the FILEs (the current directory by default).
	91	Sort entries alphabetically across.\")
	92
	93	`eshell-eval-using-options' returns the value of the last form in
4e05e67e GM	94	BODY-FORMS. If instead an external command is run (because of
	95	an unknown option), the tag `eshell-external' will be thrown with
	96	the new process for its value.
affbf647 GM	97
	98	Lastly, any remaining arguments will be available in a locally
	99	interned variable `args' (created using a `let' form)."
0d182a34	100	(declare (debug (form form sexp body)))
affbf647 GM	101	`(let ((temp-args
	102	,(if (memq ':preserve-args (cadr options))
	103	macro-args
	104	(list 'eshell-stringify-list
	105	(list 'eshell-flatten-list macro-args)))))
170266d0	106	(let ,(delq nil (mapcar (lambda (opt)
18d05bed GM	107	(and (listp opt) (nth 3 opt)))
18d05bed GM	108	(cadr options)))
a464a6c7 SM	109	;; FIXME: `options' ends up hiding some variable names under `quote',
a464a6c7 SM	110	;; which is incompatible with lexical scoping!!
170266d0	111	(eshell-do-opt ,name ,options (lambda (args) ,@body-forms) temp-args))))
affbf647 GM	112
	113	;;; Internal Functions:
	114
5ca67338	115	;; Documented part of the interface; see eshell-eval-using-options.
170266d0	116	(defvar eshell--args)
affbf647	117
170266d0	118	(defun eshell-do-opt (name options body-fun args)
affbf647 GM	119	"Helper function for `eshell-eval-using-options'.
affbf647 GM	120	This code doesn't really need to be macro expanded everywhere."
170266d0 SM	121	(let* (last-value
170266d0 SM	122	(ext-command
affbf647	123	(catch 'eshell-ext-command
170266d0	124	(let ((usage-msg
affbf647 GM	125	(catch 'eshell-usage
	126	(setq last-value nil)
	127	(if (and (= (length args) 0)
	128	(memq ':show-usage options))
	129	(throw 'eshell-usage
	130	(eshell-show-usage name options)))
	131	(setq args (eshell-process-args name args options)
170266d0 SM	132	last-value (funcall body-fun args))
	133	nil)))
	134	(when usage-msg
	135	(error "%s" usage-msg))))))
	136	(if ext-command
affbf647	137	(throw 'eshell-external
0d182a34	138	(eshell-external-command ext-command args))
170266d0	139	last-value)))
affbf647 GM	140
	141	(defun eshell-show-usage (name options)
	142	"Display the usage message for NAME, using OPTIONS."
	143	(let ((usage (format "usage: %s %s\n\n" name
	144	(cadr (memq ':usage options))))
	145	(extcmd (memq ':external options))
	146	(post-usage (memq ':post-usage options))
	147	had-option)
	148	(while options
	149	(when (listp (car options))
	150	(let ((opt (car options)))
	151	(setq had-option t)
	152	(cond ((and (nth 0 opt)
	153	(nth 1 opt))
	154	(setq usage
	155	(concat usage
	156	(format " %-20s %s\n"
	157	(format "-%c, --%s" (nth 0 opt)
	158	(nth 1 opt))
	159	(nth 4 opt)))))
	160	((nth 0 opt)
	161	(setq usage
	162	(concat usage
	163	(format " %-20s %s\n"
	164	(format "-%c" (nth 0 opt))
	165	(nth 4 opt)))))
	166	((nth 1 opt)
	167	(setq usage
	168	(concat usage
	169	(format " %-20s %s\n"
	170	(format " --%s" (nth 1 opt))
	171	(nth 4 opt)))))
	172	(t (setq had-option nil)))))
	173	(setq options (cdr options)))
	174	(if post-usage
	175	(setq usage (concat usage (and had-option "\n")
	176	(cadr post-usage))))
	177	(when extcmd
	178	(setq extcmd (eshell-search-path (cadr extcmd)))
	179	(if extcmd
	180	(setq usage
	181	(concat usage
	182	(format "
	183	This command is implemented in Lisp. If an unrecognized option is
	184	passed to this command, the external version '%s'
	185	will be called instead." extcmd)))))
	186	(throw 'eshell-usage usage)))
	187
	188	(defun eshell-set-option (name ai opt options)
	189	"Using NAME's remaining args (index AI), set the OPT within OPTIONS.
	190	If the option consumes an argument for its value, the argument list
	191	will be modified."
	192	(if (not (nth 3 opt))
	193	(eshell-show-usage name options)
	194	(if (eq (nth 2 opt) t)
170266d0	195	(if (> ai (length eshell--args))
affbf647	196	(error "%s: missing option argument" name)
170266d0	197	(set (nth 3 opt) (nth ai eshell--args))
affbf647	198	(if (> ai 0)
170266d0 SM	199	(setcdr (nthcdr (1- ai) eshell--args)
	200	(nthcdr (1+ ai) eshell--args))
	201	(setq eshell--args (cdr eshell--args))))
affbf647 GM	202	(set (nth 3 opt) (or (nth 2 opt) t)))))
	203
	204	(defun eshell-process-option (name switch kind ai options)
	205	"For NAME, process SWITCH (of type KIND), from args at index AI.
	206	The SWITCH will be looked up in the set of OPTIONS.
	207
	208	SWITCH should be either a string or character. KIND should be the
	209	integer 0 if it's a character, or 1 if it's a string.
	210
	211	The SWITCH is then be matched against OPTIONS. If no matching handler
	212	is found, and an :external command is defined (and available), it will
	213	be called; otherwise, an error will be triggered to say that the
	214	switch is unrecognized."
	215	(let* ((opts options)
	216	found)
	217	(while opts
	218	(if (and (listp (car opts))
a464a6c7 SM	219	(nth kind (car opts))
a464a6c7 SM	220	(equal switch (nth kind (car opts))))
affbf647 GM	221	(progn
	222	(eshell-set-option name ai (car opts) options)
	223	(setq found t opts nil))
	224	(setq opts (cdr opts))))
	225	(unless found
	226	(let ((extcmd (memq ':external options)))
	227	(when extcmd
	228	(setq extcmd (eshell-search-path (cadr extcmd)))
	229	(if extcmd
	230	(throw 'eshell-ext-command extcmd)
170266d0 SM	231	(error (if (characterp switch) "%s: unrecognized option -%c"
	232	"%s: unrecognized option --%s")
	233	name switch)))))))
affbf647 GM	234
	235	(defun eshell-process-args (name args options)
	236	"Process the given ARGS using OPTIONS.
4e05e67e	237	This assumes that symbols have been intern'd by `eshell-eval-using-options'."
170266d0 SM	238	(let ((ai 0) arg
170266d0 SM	239	(eshell--args args))
affbf647 GM	240	(while (< ai (length args))
	241	(setq arg (nth ai args))
	242	(if (not (and (stringp arg)
	243	(string-match "^-\\(-\\)?\\(.*\\)" arg)))
	244	(setq ai (1+ ai))
	245	(let* ((dash (match-string 1 arg))
	246	(switch (match-string 2 arg)))
	247	(if (= ai 0)
	248	(setq args (cdr args))
	249	(setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)))
	250	(if dash
	251	(if (> (length switch) 0)
	252	(eshell-process-option name switch 1 ai options)
	253	(setq ai (length args)))
	254	(let ((len (length switch))
	255	(index 0))
	256	(while (< index len)
	257	(eshell-process-option name (aref switch index) 0 ai options)
	258	(setq index (1+ index)))))))))
	259	args)
	260
affbf647	261	;;; esh-opt.el ends here