From: Karoly Lorentey Date: Fri, 20 May 2005 17:44:36 +0000 (+0000) Subject: Merged from miles@gnu.org--gnu-2005 (patch 69, 313-319) X-Git-Tag: emacs-pretest-23.0.90~11236^2~141^2~253 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b4bb3cbc7caca5c9c207d9ed42cacb978790af67;p=emacs.git Merged from miles@gnu.org--gnu-2005 (patch 69, 313-319) Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-313 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-314 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-315 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-316 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-317 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-318 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-319 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-69 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-347 --- b4bb3cbc7caca5c9c207d9ed42cacb978790af67 diff --cc lisp/font-lock.el index 444ca80f94c,ba42412d8da..86abc2a5f12 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@@ -1999,72 -1997,77 +1997,77 @@@ This function could be MATCHER in a MAT (defconst lisp-font-lock-keywords-2 (append lisp-font-lock-keywords-1 (eval-when-compile - (list - ;; - ;; Control structures. Emacs Lisp forms. - (cons (concat - "(" (regexp-opt - '("cond" "if" "while" "let" "let*" - "prog" "progn" "progv" "prog1" "prog2" "prog*" - "inline" "lambda" "save-restriction" "save-excursion" - "save-window-excursion" "save-selected-window" - "save-match-data" "save-current-buffer" "unwind-protect" - "condition-case" "track-mouse" - "eval-after-load" "eval-and-compile" "eval-when-compile" - "eval-when" - "with-category-table" - "with-current-buffer" "with-electric-help" - "with-local-quit" "with-no-warnings" - "with-output-to-string" "with-output-to-temp-buffer" - "with-selected-window" "with-selected-frame" "with-syntax-table" - "with-temp-buffer" "with-temp-file" "with-temp-message" - "with-timeout" "with-timeout-handler") t) - "\\>") - 1) - ;; - ;; Control structures. Common Lisp forms. - (cons (concat - "(" (regexp-opt - '("when" "unless" "case" "ecase" "typecase" "etypecase" - "ccase" "ctypecase" "handler-case" "handler-bind" - "restart-bind" "restart-case" "in-package" - "break" "ignore-errors" - "loop" "do" "do*" "dotimes" "dolist" "the" "locally" - "proclaim" "declaim" "declare" "symbol-macrolet" - "lexical-let" "lexical-let*" "flet" "labels" "compiler-let" - "destructuring-bind" "macrolet" "tagbody" "block" "go" - "multiple-value-bind" "multiple-value-prog1" - "return" "return-from" - "with-accessors" "with-compilation-unit" - "with-condition-restarts" "with-hash-table-iterator" - "with-input-from-string" "with-open-file" - "with-open-stream" "with-output-to-string" - "with-package-iterator" "with-simple-restart" - "with-slots" "with-standard-io-syntax") t) - "\\>") - 1) - ;; - ;; Exit/Feature symbols as constants. - (list (concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\>" - "[ \t']*\\(\\sw+\\)?") - '(1 font-lock-keyword-face) - '(2 font-lock-constant-face nil t)) - ;; - ;; Erroneous structures. - '("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\>" 1 font-lock-warning-face) - ;; - ;; Words inside \\[] tend to be for `substitute-command-keys'. - '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-constant-face prepend) - ;; - ;; Words inside `' tend to be symbol names. - '("`\\(\\sw\\sw+\\)'" 1 font-lock-constant-face prepend) - ;; - ;; Constant values. - '("\\<:\\sw+\\>" 0 font-lock-builtin-face) - ;; - ;; ELisp and CLisp `&' keywords as types. - '("\\&\\sw+\\>" . font-lock-type-face) - ;; + `(;; Control structures. Emacs Lisp forms. + (,(concat + "(" (regexp-opt + '("cond" "if" "while" "let" "let*" + "prog" "progn" "progv" "prog1" "prog2" "prog*" + "inline" "lambda" "save-restriction" "save-excursion" + "save-window-excursion" "save-selected-window" + "save-match-data" "save-current-buffer" "unwind-protect" + "condition-case" "track-mouse" + "eval-after-load" "eval-and-compile" "eval-when-compile" + "eval-when" + "with-category-table" + "with-current-buffer" "with-electric-help" + "with-local-quit" "with-no-warnings" + "with-output-to-string" "with-output-to-temp-buffer" - "with-selected-window" "with-syntax-table" ++ "with-selected-window" "with-selected-frame" "with-syntax-table" + "with-temp-buffer" "with-temp-file" "with-temp-message" + "with-timeout" "with-timeout-handler") t) + "\\>") + . 1) + ;; Control structures. Common Lisp forms. + (,(concat + "(" (regexp-opt + '("when" "unless" "case" "ecase" "typecase" "etypecase" + "ccase" "ctypecase" "handler-case" "handler-bind" + "restart-bind" "restart-case" "in-package" + "break" "ignore-errors" + "loop" "do" "do*" "dotimes" "dolist" "the" "locally" + "proclaim" "declaim" "declare" "symbol-macrolet" + "lexical-let" "lexical-let*" "flet" "labels" "compiler-let" + "destructuring-bind" "macrolet" "tagbody" "block" "go" + "multiple-value-bind" "multiple-value-prog1" + "return" "return-from" + "with-accessors" "with-compilation-unit" + "with-condition-restarts" "with-hash-table-iterator" + "with-input-from-string" "with-open-file" + "with-open-stream" "with-output-to-string" + "with-package-iterator" "with-simple-restart" + "with-slots" "with-standard-io-syntax") t) + "\\>") + . 1) + ;; Exit/Feature symbols as constants. + (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\>" + "[ \t']*\\(\\sw+\\)?") + (1 font-lock-keyword-face) + (2 font-lock-constant-face nil t)) + ;; Erroneous structures. + ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\>" 1 font-lock-warning-face) + ;; Words inside \\[] tend to be for `substitute-command-keys'. + ("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-constant-face prepend) + ;; Words inside `' tend to be symbol names. + ("`\\(\\sw\\sw+\\)'" 1 font-lock-constant-face prepend) + ;; Constant values. + ("\\<:\\sw+\\>" 0 font-lock-builtin-face) + ;; ELisp and CLisp `&' keywords as types. + ("\\&\\sw+\\>" . font-lock-type-face) + ;; Make regexp grouping constructs bold, so they stand out, but only in strings. + ((lambda (bound) + (if (re-search-forward "\\([\\][\\]\\)\\([(|)]\\)\\(\\?:\\)?" bound) + (let ((face (get-text-property (1- (point)) 'face))) + (if (listp face) + (memq 'font-lock-string-face face) + (eq 'font-lock-string-face face))))) + (1 font-lock-comment-face prepend) ; Should we introduce a lowlight face for this? + ; Ideally that would retain the color, dimmed 50%. + (2 'bold prepend) + (3 font-lock-type-face prepend t)) + ;; Underline innermost grouping, so that you can more easily see what belongs together. + ;; 2005-05-12: Font-lock can go into an unbreakable endless loop on this -- something's broken. + ;;("[\\][\\][(]\\(?:\\?:\\)?\\(\\(?:[^\\\"]+\\|[\\]\\(?:[^\\]\\|[\\][^(]\\)\\)+?\\)[\\][\\][)]" + ;;1 'underline prepend) ;;; This is too general -- rms. ;;; A user complained that he has functions whose names start with `do' ;;; and that they get the wrong color. diff --cc lisp/server.el index ef58306a9a5,0a5fc942206..f3f04d26fd5 --- a/lisp/server.el +++ b/lisp/server.el @@@ -548,228 -295,91 +548,228 @@@ The following commands are accepted by (when prev (setq string (concat prev string)) (process-put proc 'previous-string nil))) - ;; If the input is multiple lines, - ;; process each line individually. - (while (string-match "\n" string) - (let ((request (substring string 0 (match-beginning 0))) - (coding-system (and default-enable-multibyte-characters - (or file-name-coding-system - default-file-name-coding-system))) - client nowait eval - (files nil) - (lineno 1) - (tmp-frame nil) ; Sometimes used to embody the selected display. - (columnno 0)) - ;; Remove this line from STRING. - (setq string (substring string (match-end 0))) - (setq client (cons proc nil)) - (while (string-match "[^ ]* " request) - (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) - (setq request (substring request (match-end 0))) - (cond - ((equal "-nowait" arg) (setq nowait t)) - ((equal "-eval" arg) (setq eval t)) - ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) - (let ((display (server-unquote-arg (match-string 1 request)))) - (setq request (substring request (match-end 0))) - (condition-case err - (setq tmp-frame (server-select-display display)) - (error (process-send-string proc (nth 1 err)) - (setq request ""))))) - ;; ARG is a line number option. - ((string-match "\\`\\+[0-9]+\\'" arg) - (setq lineno (string-to-number (substring arg 1)))) - ;; ARG is line number:column option. - ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) - (setq lineno (string-to-number (match-string 1 arg)) - columnno (string-to-number (match-string 2 arg)))) - (t - ;; Undo the quoting that emacsclient does - ;; for certain special characters. - (setq arg (server-unquote-arg arg)) - ;; Now decode the file name if necessary. - (if coding-system - (setq arg (decode-coding-string arg coding-system))) - (if eval - (let ((v (eval (car (read-from-string arg))))) - (when v - (with-temp-buffer - (let ((standard-output (current-buffer))) - (pp v) - ;; Suppress the error rose when the pipe to PROC is closed. - (condition-case err - (process-send-region proc (point-min) (point-max)) - (file-error nil) - (error nil)) - )))) - ;; ARG is a file name. - ;; Collapse multiple slashes to single slashes. - (setq arg (command-line-normalize-file-name arg)) - (push (list arg lineno columnno) files)) - (setq lineno 1) - (setq columnno 0))))) - (when files - (run-hooks 'pre-command-hook) - (server-visit-files files client nowait) - (run-hooks 'post-command-hook)) - ;; CLIENT is now a list (CLIENTNUM BUFFERS...) - (if (null (cdr client)) - ;; This client is empty; get rid of it immediately. - (progn - (delete-process proc) - (server-log "Close empty client" proc)) - ;; We visited some buffer for this client. - (or nowait (push client server-clients)) - (unless (or isearch-mode (minibufferp)) - (server-switch-buffer (nth 1 client)) - (run-hooks 'server-switch-hook) - (unless nowait - (message (substitute-command-keys - "When done with a buffer, type \\[server-edit]"))))) - ;; Avoid preserving the connection after the last real frame is deleted. - (if tmp-frame (delete-frame tmp-frame)))) - ;; Save for later any partial line that remains. - (when (> (length string) 0) - (process-put proc 'previous-string string))) + (condition-case err + (progn + (server-add-client proc) + ;; If the input is multiple lines, + ;; process each line individually. + (while (string-match "\n" string) + (let ((request (substring string 0 (match-beginning 0))) + (coding-system (and default-enable-multibyte-characters + (or file-name-coding-system + default-file-name-coding-system))) + (client (server-client proc)) + nowait ; t if emacsclient does not want to wait for us. + frame ; The frame that was opened for the client (if any). + display ; Open the frame on this display. + dontkill ; t if the client should not be killed. + (files nil) + (lineno 1) + (columnno 0)) + ;; Remove this line from STRING. + (setq string (substring string (match-end 0))) + (while (string-match " *[^ ]* " request) + (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) + (setq request (substring request (match-end 0))) + (cond + ;; -version CLIENT-VERSION: + ;; Check version numbers, signal an error if there is a mismatch. + ((and (equal "-version" arg) + (string-match "\\([0-9.]+\\) " request)) + (let* ((client-version (match-string 1 request)) + (truncated-emacs-version + (substring emacs-version 0 (length client-version)))) + (setq request (substring request (match-end 0))) + (if (equal client-version truncated-emacs-version) + (progn + (server-send-string proc "-good-version \n") + (server-client-set client 'version client-version)) + (error (concat "Version mismatch: Emacs is " + truncated-emacs-version + ", emacsclient is " client-version))))) + + ;; -nowait: Emacsclient won't wait for a result. + ((equal "-nowait" arg) (setq nowait t)) + + ;; -display DISPLAY: + ;; Open X frames on the given instead of the default. + ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) + (setq display (match-string 1 request) + request (substring request (match-end 0)))) + + ;; -window-system: Open a new X frame. + ((equal "-window-system" arg) + (unless (server-client-get client 'version) + (error "Protocol error; make sure to use the correct version of emacsclient")) + (if (fboundp 'x-create-frame) + (progn + (setq frame (make-frame-on-display + (or display + (frame-parameter nil 'display) + (getenv "DISPLAY") + (error "Please specify display")) + (list (cons 'client proc)))) + ;; XXX We need to ensure the client parameter is + ;; really set because Emacs forgets initialization + ;; parameters for X frames at the moment. + (modify-frame-parameters frame (list (cons 'client proc))) + (select-frame frame) + (server-client-set client 'frame frame) + (server-client-set client 'display (frame-display frame)) + (setq dontkill t)) + ;; This emacs does not support X. + (server-log "Window system unsupported" proc) + (server-send-string proc "-window-system-unsupported \n") + (setq dontkill t))) + + ;; -resume: Resume a suspended tty frame. + ((equal "-resume" arg) + (let ((display-id (server-client-get client 'display))) + (setq dontkill t) + (when (eq (display-live-p display-id) t) + (resume-tty display-id)))) + + ;; -suspend: Suspend the client's frame. (In case we + ;; get out of sync, and a C-z sends a SIGTSTP to + ;; emacsclient.) + ((equal "-suspend" arg) + (let ((display-id (server-client-get client 'display))) + (setq dontkill t) + (when (eq (display-live-p display-id) t) + (suspend-tty display-id)))) + + ;; -ignore COMMENT: Noop; useful for debugging emacsclient. + ;; (The given comment appears in the server log.) + ((and (equal "-ignore" arg) (string-match "\\([^ ]*\\) " request)) + (setq dontkill t + request (substring request (match-end 0)))) + + ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client. + ((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request)) + (let ((tty (server-unquote-arg (match-string 1 request))) + (type (server-unquote-arg (match-string 2 request)))) + (setq request (substring request (match-end 0))) + (unless (server-client-get client 'version) + (error "Protocol error; make sure you use the correct version of emacsclient")) + (server-with-client-environment proc + ("LANG" "LC_CTYPE" "LC_ALL" + ;; For tgetent(3); list according to ncurses(3). + "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES" + "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING" + "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO" + "TERMINFO_DIRS" "TERMPATH") + (setq frame (make-frame-on-tty tty type + `((client . ,proc))))) + (select-frame frame) + (server-client-set client 'frame frame) + (server-client-set client 'tty (display-name frame)) + (server-client-set client 'display (frame-display frame)) + + ;; Reply with our pid. + (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n")) + (setq dontkill t))) + + ;; -position LINE: Go to the given line in the next file. + ((and (equal "-position" arg) (string-match "\\(\\+[0-9]+\\) " request)) + (setq request (substring request (match-end 0)) - lineno (string-to-int (substring (match-string 1 request) 1)))) ++ lineno (string-to-number (substring (match-string 1 request) 1)))) + + ;; -position LINE:COLUMN: Set point to the given position in the next file. + ((and (equal "-position" arg) (string-match "\\+\\([0-9]+\\):\\([0-9]+\\) " request)) - (setq lineno (string-to-int (match-string 1 request)) - columnno (string-to-int (match-string 2 request)) ++ (setq lineno (string-to-number (match-string 1 request)) ++ columnno (string-to-number (match-string 2 request)) + request (substring request (match-end 0)))) + + ;; -file FILENAME: Load the given file. + ((and (equal "-file" arg) (string-match "\\([^ ]+\\) " request)) + (let ((file (server-unquote-arg (match-string 1 request)))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq file (decode-coding-string file coding-system))) + (setq file (command-line-normalize-file-name file)) + (push (list file lineno columnno) files)) + (setq lineno 1 + columnno 0)) + + ;; -eval EXPR: Evaluate a Lisp expression. + ((and (equal "-eval" arg) (string-match "\\([^ ]+\\) " request)) + (let ((expr (server-unquote-arg (match-string 1 request)))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq expr (decode-coding-string expr coding-system))) + (let ((v (eval (car (read-from-string expr))))) + (when (and (not frame) v) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (pp v) + (server-send-string + proc (format "-print %s\n" + (server-quote-arg + (buffer-substring-no-properties (point-min) + (point-max))))))))) + (setq lineno 1 + columnno 0))) + + ;; -env NAME VALUE: An environment variable. + ((and (equal "-env" arg) (string-match "\\([^ ]+\\) \\([^ ]+\\) " request)) + (let ((name (server-unquote-arg (match-string 1 request))) + (value (server-unquote-arg (match-string 2 request)))) + (when coding-system + (setq name (decode-coding-string name coding-system)) + (setq value (decode-coding-string value coding-system))) + (setq request (substring request (match-end 0))) + (server-client-set + client 'environment + (cons (cons name value) + (server-client-get client 'environment))))) + + ;; Unknown command. + (t (error "Unknown command: %s" arg))))) + + (let (buffers) + (when files + (run-hooks 'pre-command-hook) + (setq buffers (server-visit-files files client nowait)) + (run-hooks 'post-command-hook)) + + ;; Delete the client if necessary. + (cond + (nowait + ;; Client requested nowait; return immediately. + (server-log "Close nowait client" proc) + (server-delete-client proc)) + ((and (not dontkill) (null buffers)) + ;; This client is empty; get rid of it immediately. + (server-log "Close empty client" proc) + (server-delete-client proc))) + (cond + ((or isearch-mode (minibufferp)) + nil) + ((and frame (null buffers)) + (message (substitute-command-keys + "When done with this frame, type \\[delete-frame]"))) + ((not (null buffers)) + (server-switch-buffer (car buffers)) + (run-hooks 'server-switch-hook) + (unless nowait + (message (substitute-command-keys + "When done with a buffer, type \\[server-edit]")))))))) + + ;; Save for later any partial line that remains. + (when (> (length string) 0) + (process-put proc 'previous-string string))) + ;; condition-case + (error (ignore-errors + (server-send-string + proc (concat "-error " (server-quote-arg (error-message-string err)))) + (setq string "") + (server-log (error-message-string err) proc) + (delete-process proc))))) (defun server-goto-line-column (file-line-col) + "Move point to the position indicated in FILE-LINE-COL. +FILE-LINE-COL should be a three-element list as described in +`server-visit-files'." (goto-line (nth 1 file-line-col)) (let ((column-number (nth 2 file-line-col))) (if (> column-number 0)