(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.
(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)
projects / emacs.git / commitdiff