1

I found this solution (https://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00322.html, fully cited below), but it isn't working as expected. It highlights only the first definition inside labels/flet/macrolet.

enter image description here

... and here the source code of the example for reproduction:

(defun fn ()
  (labels ((%fn0 ())
           (%fn1 ())
           (%fn2 ())))
  (flet ((%fn0 ())
         (%fn1 ())
         (%fn2 ())))
  (macrolet ((%fn0 ())
             (%fn1 ())
             (%fn2 ()))))

I am wondering if there is a working solution to highlight in-function definitions?

Full quotation of https://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00322.html:

;; Highlighting of flet/labels/macrolet local functions/macros with
;; font-lock-function-name-face

(defun mm/match-labels (bound)
  (when (re-search-forward "(\\<\\(labels\\|flet\\|macrolet\\)\\>" bound t)
    (let ((local-functions '())
          (all-start (match-beginning 0))
          (all-end (match-end 0))
          (kw-start (match-beginning 1))
          (kw-end (match-end 1))
          (parse-sexp-ignore-comments t))
      (catch 'done
        (condition-case e
            (progn
              ;; go inside the local functions list
              (goto-char (scan-lists all-end 1 -1))
              (while t
                (save-excursion 
                  ;; down into local function definition
                  (goto-char (scan-lists (point) 1 -1))
                  (let* ((name-end (scan-sexps (point) 1))
                         (name-start (scan-sexps name-end -1)))
                    (push name-end local-functions)
                    (push name-start local-functions)))
                ;; advance to the next local function
                (goto-char (scan-sexps (point) 1))))
          (error
           ;; (message "got error %s" e)
           (throw 'done nil))))
      (set-match-data (append
                       (list all-start all-end
                             kw-start kw-end)
                       (nreverse local-functions)
                       (list (current-buffer))))
      (goto-char all-end)
      t)))

(font-lock-add-keywords
 'lisp-mode
 `((mm/match-labels
    (1 font-lock-keyword-face nil)
    (2 font-lock-function-name-face nil t)
    (3 font-lock-function-name-face nil t)
    (4 font-lock-function-name-face nil t)
    (5 font-lock-function-name-face nil t)
    (6 font-lock-function-name-face nil t)
    (7 font-lock-function-name-face nil t)
    (8 font-lock-function-name-face nil t))))
1

In the code from https://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00322.html the pushes are in wrong order. The code below with corrected order of the pushes works as it is expected to work.

But, be aware that the code is very experimental. It just fontifies seven function definitions (subexpressions of the match).

Maybe, a better implementation would be based on an anchored highlight (see the documentation of variable font-lock-keywords). But, that is only a guess. I think it would even be better to use a proper lisp reader for parsing.

(defun mm/match-labels (bound)
  (when (re-search-forward "(\\<\\(labels\\|flet\\|macrolet\\)\\>" bound t)
    (let ((local-functions '())
          (all-start (match-beginning 0))
          (all-end (match-end 0))
          (kw-start (match-beginning 1))
          (kw-end (match-end 1))
          (parse-sexp-ignore-comments t))
      (catch 'done
        (condition-case e
            (progn
              ;; go inside the local functions list
              (goto-char (scan-lists all-end 1 -1))
              (while t
                (save-excursion 
                  ;; down into local function definition
                  (goto-char (scan-lists (point) 1 -1))
                  (let* ((name-end (scan-sexps (point) 1))
                         (name-start (scan-sexps name-end -1)))
                    (push name-start local-functions)
                    (push name-end local-functions)))
                ;; advance to the next local function
                (goto-char (scan-sexps (point) 1))))
          (error
           ;; (message "got error %s" e)
           (throw 'done nil))))
      (set-match-data (append
                       (list all-start all-end
                             kw-start kw-end)
                       (nreverse local-functions)
                       (list (current-buffer))))
      (goto-char all-end)
      t)))

(font-lock-add-keywords
 'lisp-mode
 `((mm/match-labels
    (1 font-lock-keyword-face nil)
    (2 font-lock-function-name-face nil t)
    (3 font-lock-function-name-face nil t)
    (4 font-lock-function-name-face nil t)
    (5 font-lock-function-name-face nil t)
    (6 font-lock-function-name-face nil t)
    (7 font-lock-function-name-face nil t)
    (8 font-lock-function-name-face nil t))))
  • Thank you for fixing the code and also for making my question more readable! I do understand that it only colors seven definitions, but since it is rather rare to have more than seven in-function definitions (at least in the codebase I'm working with), that will do. – Danylo Fedorov Dec 1 '17 at 14:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.