diff options
Diffstat (limited to 'lisp/emacs-lisp/lisp-mode.el')
| -rw-r--r-- | lisp/emacs-lisp/lisp-mode.el | 120 |
1 files changed, 76 insertions, 44 deletions
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1cdba5b371a..31df353321a 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -104,7 +104,8 @@ It has `lisp-mode-abbrev-table' as its parent." (regexp-opt '("defun" "defun*" "defsubst" "defmacro" "defadvice" "define-skeleton" - "define-minor-mode" "define-global-minor-mode" + "define-compilation-mode" "define-minor-mode" + "define-global-minor-mode" "define-globalized-minor-mode" "define-derived-mode" "define-generic-mode" "define-compiler-macro" "define-modify-macro" @@ -156,6 +157,24 @@ It has `lisp-mode-abbrev-table' as its parent." ;;;; Font-lock support. +(defun lisp--match-hidden-arg (limit) + (let ((res nil)) + (while + (let ((ppss (parse-partial-sexp (line-beginning-position) + (line-end-position) + -1))) + (skip-syntax-forward " )") + (if (or (>= (car ppss) 0) + (looking-at ";\\|$")) + (progn + (forward-line 1) + (< (point) limit)) + (looking-at ".*") ;Set the match-data. + (forward-line 1) + (setq res (point)) + nil))) + res)) + (pcase-let ((`(,vdefs ,tdefs ,el-defs-re ,cl-defs-re @@ -189,6 +208,7 @@ It has `lisp-mode-abbrev-table' as its parent." "with-category-table" "with-coding-priority" "with-current-buffer" "with-demoted-errors" "with-electric-help" "with-eval-after-load" + "with-file-modes" "with-local-quit" "with-no-warnings" "with-output-to-temp-buffer" "with-selected-window" "with-selected-frame" "with-silent-modifications" @@ -347,6 +367,9 @@ It has `lisp-mode-abbrev-table' as its parent." ;; and that they get the wrong color. ;; ;; CL `with-' and `do-' constructs ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + (lisp--match-hidden-arg + (0 '(face font-lock-warning-face + help-echo "Hidden behind deeper element; move to another line?"))) )) "Gaudy level highlighting for Emacs Lisp mode.") @@ -377,6 +400,9 @@ It has `lisp-mode-abbrev-table' as its parent." ;; and that they get the wrong color. ;; ;; CL `with-' and `do-' constructs ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + (lisp--match-hidden-arg + (0 '(face font-lock-warning-face + help-echo "Hidden behind deeper element; move to another line?"))) )) "Gaudy level highlighting for Lisp modes.")) @@ -387,6 +413,41 @@ It has `lisp-mode-abbrev-table' as its parent." (defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1 "Default expressions to highlight in Lisp modes.") +(defun lisp-string-in-doc-position-p (listbeg startpos) + (let* ((firstsym (and listbeg + (save-excursion + (goto-char listbeg) + (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") + (match-string 1))))) + (docelt (and firstsym + (function-get (intern-soft firstsym) + lisp-doc-string-elt-property)))) + (and docelt + ;; It's a string in a form that can have a docstring. + ;; Check whether it's in docstring position. + (save-excursion + (when (functionp docelt) + (goto-char (match-end 1)) + (setq docelt (funcall docelt))) + (goto-char listbeg) + (forward-char 1) + (condition-case nil + (while (and (> docelt 0) (< (point) startpos) + (progn (forward-sexp 1) t)) + (setq docelt (1- docelt))) + (error nil)) + (and (zerop docelt) (<= (point) startpos) + (progn (forward-comment (point-max)) t) + (= (point) startpos)))))) + +(defun lisp-string-after-doc-keyword-p (listbeg startpos) + (and listbeg ; We are inside a Lisp form. + (save-excursion + (goto-char startpos) + (ignore-errors + (progn (backward-sexp 1) + (looking-at ":documentation\\_>")))))) + (defun lisp-font-lock-syntactic-face-function (state) (if (nth 3 state) ;; This might be a (doc)string or a |...| symbol. @@ -394,32 +455,9 @@ It has `lisp-mode-abbrev-table' as its parent." (if (eq (char-after startpos) ?|) ;; This is not a string, but a |...| symbol. nil - (let* ((listbeg (nth 1 state)) - (firstsym (and listbeg - (save-excursion - (goto-char listbeg) - (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") - (match-string 1))))) - (docelt (and firstsym - (function-get (intern-soft firstsym) - lisp-doc-string-elt-property)))) - (if (and docelt - ;; It's a string in a form that can have a docstring. - ;; Check whether it's in docstring position. - (save-excursion - (when (functionp docelt) - (goto-char (match-end 1)) - (setq docelt (funcall docelt))) - (goto-char listbeg) - (forward-char 1) - (condition-case nil - (while (and (> docelt 0) (< (point) startpos) - (progn (forward-sexp 1) t)) - (setq docelt (1- docelt))) - (error nil)) - (and (zerop docelt) (<= (point) startpos) - (progn (forward-comment (point-max)) t) - (= (point) (nth 8 state))))) + (let ((listbeg (nth 1 state))) + (if (or (lisp-string-in-doc-position-p listbeg startpos) + (lisp-string-after-doc-keyword-p listbeg startpos)) font-lock-doc-face font-lock-string-face)))) font-lock-comment-face)) @@ -465,10 +503,10 @@ font-lock keywords will not be case sensitive." lisp-cl-font-lock-keywords-2)) nil ,keywords-case-insensitive nil nil (font-lock-mark-block-function . mark-defun) + (font-lock-extra-managed-props help-echo) (font-lock-syntactic-face-function . lisp-font-lock-syntactic-face-function))) (setq-local prettify-symbols-alist lisp--prettify-symbols-alist) - ;; electric (when elisp (setq-local electric-pair-text-pairs (cons '(?\` . ?\') electric-pair-text-pairs))) @@ -992,26 +1030,20 @@ If CHAR is not a character, return nil." (forward-sexp -1)))) (save-restriction - ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in - ;; `variable' so that the value is returned, not the - ;; name - (if (and ignore-quotes - (eq (following-char) ?`)) + (if (and ignore-quotes (eq (following-char) ?`)) + ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so + ;; that the value is returned, not the name. (forward-char)) + (when (looking-at ",@?") (goto-char (match-end 0))) (narrow-to-region (point-min) opoint) (setq expr (read (current-buffer))) - ;; If it's an (interactive ...) form, it's more - ;; useful to show how an interactive call would - ;; use it. - (and (consp expr) - (eq (car expr) 'interactive) + ;; If it's an (interactive ...) form, it's more useful to show how an + ;; interactive call would use it. + ;; FIXME: Is it really the right place for this? + (when (eq (car-safe expr) 'interactive) (setq expr - (list 'call-interactively - (list 'quote - (list 'lambda - '(&rest args) - expr - 'args))))) + `(call-interactively + (lambda (&rest args) ,expr args)))) expr))))) |