*** trunk/lib-src/emacsclient.c 2013-03-13 19:48:00.017919000 -0400 --- my-work/lib-src/emacsclient.c 2013-03-23 21:47:53.065402783 -0400 *************** *** 163,168 **** --- 163,173 ---- /* PID of the Emacs server process. */ int emacs_pid = 0; + /* Custom options */ + #define MAX_CUSTOM_OPTIONS (32) + const char *custom_options[MAX_CUSTOM_OPTIONS]; + int custopts = 0; + /* If non-NULL, a string that should form a frame parameter alist to be used for the new frame */ const char *frame_parameters = NULL; *************** *** 473,478 **** --- 478,484 ---- { alternate_editor = egetenv ("ALTERNATE_EDITOR"); + opterr = 0; /* don't display an error */ while (1) { int opt = getopt_long_only (argc, argv, *************** *** 554,559 **** --- 560,574 ---- frame_parameters = optarg; break; + case '?': + if (custopts < MAX_CUSTOM_OPTIONS) + custom_options [custopts++] = argv[optind-1]; + + else + message (TRUE, "%s: too many custom options: %s\n", progname, argv[optind-1]); + + break; + default: message (TRUE, "Try `%s --help' for more information\n", progname); exit (EXIT_FAILURE); *************** *** 660,666 **** " If EDITOR is the empty string, start Emacs in daemon\n\ mode and try connecting again\n" #endif /* not WINDOWSNT */ ! "\n\ Report bugs with M-x report-emacs-bug.\n", progname); exit (EXIT_SUCCESS); } --- 675,686 ---- " If EDITOR is the empty string, start Emacs in daemon\n\ mode and try connecting again\n" #endif /* not WINDOWSNT */ ! "--XXX Custom option XXX\n\ ! --XXX=YYY Custom option XXX with value YYY\n\ ! See `server-custom-option-list' and ! `server-custom-option-functions' to setup \n\ ! custom options\n\ ! \n\ Report bugs with M-x report-emacs-bug.\n", progname); exit (EXIT_SUCCESS); } *************** *** 1549,1555 **** /* Process options. */ decode_options (argc, argv); ! if ((argc - optind < 1) && !eval && current_frame) { message (TRUE, "%s: file name or argument required\n" "Try `%s --help' for more information\n", --- 1569,1575 ---- /* Process options. */ decode_options (argc, argv); ! if ((argc - optind < 1) && !eval && !custopts && current_frame) { message (TRUE, "%s: file name or argument required\n" "Try `%s --help' for more information\n", *************** *** 1651,1656 **** --- 1671,1693 ---- if (!current_frame && !tty) send_to_emacs (emacs_socket, "-window-system "); + if (custopts) + { + int i; + const char *opt; + for (i = 0; i < custopts; ++i) + { + /* Skip leading hyphens */ + for (opt = custom_options[i]; *opt == '-'; ++opt) + ; + + /* Send custom options to the server */ + send_to_emacs (emacs_socket, "-custom "); + quote_argument (emacs_socket, opt); + send_to_emacs (emacs_socket, " "); + } + } + if ((argc - optind > 0)) { int i; *** trunk/lisp/server.el 2013-03-02 22:36:33.309144000 -0500 --- my-work/lisp/server.el 2013-03-23 21:02:22.090413274 -0400 *************** *** 262,267 **** --- 262,302 ---- :type 'string :version "23.1") + ;; Custom options + (defcustom server-custom-option-functions nil + "A list of functions to handle custom options. + The functions accept four arguments: a buffer, a process, the + option string and the option value. If this variable is nil, + then no options are accepted, regardless of the setting of + `server-custom-option-list'. The functions on this hook variable + are called once before files or expressions are processed with + the buffer set to nil. After each file is opened, the hooks will + be called again, this time with the file buffer passed as the + first argument." + :group 'server + :type 'hook + :version "24.4") + + (defcustom server-custom-option-list nil + "A list that defines the acceptable custom options. + If this variable is nil, all unrecognized options are assumed to + be valid custom options. If this variable is a list then each + element defines an acceptable option. Each list entry should be + either a string with the option name that does not accept a + value, or a list whose first entry is a string containing the + option name and the optional second entry is a type predicate. + If the type predicate is `string-only', then the option value is + simply treated as a string; any other predicate forces the value + to be interpreted by the elisp reader and passed to the predicate + to validate it's value. " + :group 'server + :type '(repeat (choice (string :tag "Option") + (list :tag "Option=Parameter" + (string :tag "Option") + (choice (const :tag "String-only" string-only) + (function :tag "Parameter predicate"))))) + :version "24.4") + ;; We do not use `temporary-file-directory' here, because emacsclient ;; does not read the init file. (defvar server-socket-dir *************** *** 955,960 **** --- 990,998 ---- Go to the given line and column number in the next file opened. + `-custom OPTION[=PARM] + Invoke a custom option. + `-file FILENAME' Load the given file in the current frame. *************** *** 1055,1060 **** --- 1093,1099 ---- parent-id ; Window ID for XEmbed dontkill ; t if client should not be killed. commands + customs dir use-current-frame frame-parameters ;parameters for newly created frame *************** *** 1157,1162 **** --- 1196,1215 ---- (string-to-number (or (match-string 2 arg) "")))))) + ;; -custom OPTION[=PARM] + ;; invoke custom lisp code + (`"-custom" + (let ((option (pop args-left))) + (if (not server-custom-option-functions) + (error "Custom options are not accepted --%s" option) + + (if coding-system + (setq option (decode-coding-string option coding-system))) + (server-log (format "Custom: %s" option) proc) + + (push (server-custom-option-parse option) customs))) + (setq filepos nil)) + ;; -file FILENAME: Load the given file. (`"-file" (let ((file (pop args-left))) *************** *** 1233,1239 **** (let ((default-directory (if (and dir (file-directory-p dir)) dir default-directory))) ! (server-execute proc files nowait commands dontkill frame tty-name))))) (when (or frame files) --- 1286,1292 ---- (let ((default-directory (if (and dir (file-directory-p dir)) dir default-directory))) ! (server-execute proc files nowait commands customs dontkill frame tty-name))))) (when (or frame files) *************** *** 1243,1249 **** ;; condition-case (error (server-return-error proc err)))) ! (defun server-execute (proc files nowait commands dontkill frame tty-name) ;; This is run from timers and process-filters, i.e. "asynchronously". ;; But w.r.t the user, this is not really asynchronous since the timer ;; is run after 0s and the process-filter is run in response to the --- 1296,1302 ---- ;; condition-case (error (server-return-error proc err)))) ! (defun server-execute (proc files nowait commands customs dontkill frame tty-name) ;; This is run from timers and process-filters, i.e. "asynchronously". ;; But w.r.t the user, this is not really asynchronous since the timer ;; is run after 0s and the process-filter is run in response to the *************** *** 1253,1265 **** ;; including code that needs to wait. (with-local-quit (condition-case err ! (let ((buffers (server-visit-files files proc nowait))) (mapc 'funcall (nreverse commands)) ;; If we were told only to open a new client, obey ;; `initial-buffer-choice' if it specifies a file ;; or a function. ! (unless (or files commands) (let ((buf (cond ((stringp initial-buffer-choice) (find-file-noselect initial-buffer-choice)) --- 1306,1318 ---- ;; including code that needs to wait. (with-local-quit (condition-case err ! (let ((buffers (server-visit-files files customs proc nowait))) (mapc 'funcall (nreverse commands)) ;; If we were told only to open a new client, obey ;; `initial-buffer-choice' if it specifies a file ;; or a function. ! (unless (or files commands customs) (let ((buf (cond ((stringp initial-buffer-choice) (find-file-noselect initial-buffer-choice)) *************** *** 1319,1333 **** (when (> column-number 0) (move-to-column (1- column-number)))))) ! (defun server-visit-files (files proc &optional nowait) "Find FILES and return a list of buffers created. FILES is an alist whose elements are (FILENAME . FILEPOS) where FILEPOS can be nil or a pair (LINENUMBER . COLUMNNUMBER). PROC is the client that requested this operation. NOWAIT non-nil means this client is not waiting for the results, ! so don't mark these buffers specially, just visit them normally." ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries. (let ((last-nonmenu-event t) client-record) ;; Restore the current buffer afterward, but not using save-excursion, ;; because we don't want to save point in this buffer ;; if it happens to be one of those specified by the server. --- 1372,1391 ---- (when (> column-number 0) (move-to-column (1- column-number)))))) ! (defun server-visit-files (files customs proc &optional nowait) "Find FILES and return a list of buffers created. FILES is an alist whose elements are (FILENAME . FILEPOS) where FILEPOS can be nil or a pair (LINENUMBER . COLUMNNUMBER). PROC is the client that requested this operation. NOWAIT non-nil means this client is not waiting for the results, ! so don't mark these buffers specially, just visit them normally. ! ! CUSTOMS are run within the context of the buffer of the opened ! file." ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries. (let ((last-nonmenu-event t) client-record) + ;; Invoke custom options at the process level + (server-custom-option-call nil proc customs) ;; Restore the current buffer afterward, but not using save-excursion, ;; because we don't want to save point in this buffer ;; if it happens to be one of those specified by the server. *************** *** 1367,1372 **** --- 1425,1434 ---- ;; When the buffer is killed, inform the clients. (add-hook 'kill-buffer-hook 'server-kill-buffer nil t) (push proc server-buffer-clients)) + ;; Wait until here to invoke custom options so all the server + ;; related stuff is established. But doing this earlier + ;; before some hooks can be justified as well. + (server-custom-option-call (current-buffer) proc customs) (push (current-buffer) client-record))) (unless nowait (process-put proc 'buffers *************** *** 1510,1515 **** --- 1572,1642 ---- (when server-process (server-buffer-done (current-buffer) t)))))) + (defun server-custom-option-parse-1 (option svalue pred) + ;; We have encountered an OPTION with a string value SVALUE. If + ;; PRED is non-nil, then a value is expected; if nil, then no value + ;; is accepted. If PRED is `string-only, then the VALUE is left as + ;; a string; otherwise VALUE is run through the elisp parser and + ;; converted to elisp types. If PRED is t, then any value is + ;; acceptable, otherwise the PRED is a single operand predicate to + ;; verify the data type of the parsed value is acceptable. + (let (value) + ;; We can't supply a value if there is no predicate + (when (and (not pred) svalue) + (error "Custom option --%s does not accept a value" option)) + ;; Is there a value? + (if (or svalue (< 0 (length svalue))) + ;; We have a string value, is that all we want + (if (eq pred 'string-only) + (cons option svalue) + ;; We want a lisp value, parse it make sure we got it all + (setq value (read-from-string svalue)) + (when (> (length svalue) (cdr value)) + (error "Invalid custom option value --%s=%s" option svalue)) + (setq value (car value)) + ;; Validate it + (if (or (eq pred t) + (funcall pred value)) + (cons option value) + (error "Custom option --%s expected a(n) `%s' value, got `%s'" + option pred value))) + ;; Treat nil and empty strings as a nil value + (cons option nil)))) + + (defun server-custom-option-parse (option-value) + (let (option svalue result) + (if (not (string-match "\\`\\([^=]+\\)\\(?:[=]\\(.*\\)\\)?\\'" option-value)) + (error "Invalid custom option format --%s" option-value) + (setq option (match-string 1 option-value) + svalue (match-string 2 option-value)) + ;; look-up the option + (if (not server-custom-option-list) + (setq result (cons option svalue)) + (dolist (o server-custom-option-list) + (cond + ;; defn is a string, expect no value + ((and (stringp o) + (string= o option)) + (setq result + (server-custom-option-parse-1 option svalue nil))) + ;; defn is a list, expect a value, second elem is type + ((and (consp o) + (string= (car o) option)) + (setq result + (server-custom-option-parse-1 option svalue (or (cadr o) t)))))))) + (if result + result + (error "Unrecognized custom option --%s" option)))) + + (defun server-custom-option-call (buf proc customs) + (server-log (format "server-custom-option-call: `%s'" + (or (buffer-name buf) (process-name proc))) proc) + (with-local-quit + (dolist (c customs) + (run-hook-with-args 'server-custom-option-functions + buf proc (car c) (cdr c))))) + + (defun server-edit (&optional arg) "Switch to next server editing buffer; say \"Done\" for current buffer. If a server buffer is current, it is marked \"done\" and optionally saved.