dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

highlight-function-calls.el (6463B)


      1 ;;; highlight-function-calls.el --- Highlight function/macro calls  -*- lexical-binding: t; -*-
      2 
      3 ;; Author: Adam Porter <adam@alphapapa.net>
      4 ;; Url: http://github.com/alphapapa/highlight-function-calls
      5 ;; Version: 0.1-pre
      6 ;; Package-Requires: ((emacs "24.4"))
      7 ;; Keywords: faces, highlighting
      8 
      9 ;;; Commentary:
     10 
     11 ;; This package highlights function symbols in function calls.  This
     12 ;; makes them stand out from other symbols, which makes it easy to see
     13 ;; where calls to other functions are.  Optionally, macros and special
     14 ;; forms can be highlighted as well.  Also, a list of symbols can be
     15 ;; excluded from highlighting; by default, ones like +/-, </>, error,
     16 ;; require, etc. are excluded.  Finally, the `not' function can be
     17 ;; highlighted specially.
     18 
     19 ;; Just run `highlight-function-calls-mode' to activate, or you can
     20 ;; add that to your `emacs-lisp-mode-hook' to do it automatically.
     21 
     22 ;;; License:
     23 
     24 ;; This program is free software; you can redistribute it and/or modify
     25 ;; it under the terms of the GNU General Public License as published by
     26 ;; the Free Software Foundation, either version 3 of the License, or
     27 ;; (at your option) any later version.
     28 
     29 ;; This program is distributed in the hope that it will be useful,
     30 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     31 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     32 ;; GNU General Public License for more details.
     33 
     34 ;; You should have received a copy of the GNU General Public License
     35 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     36 
     37 ;;; Code:
     38 
     39 (defgroup highlight-function-calls nil
     40   "Options for highlighting function/macro calls and special forms."
     41   :group 'faces)
     42 
     43 (defface highlight-function-calls-face
     44   '((t (:underline t)))
     45   "Face for highlighting function calls."
     46   :group 'highlight-function-calls)
     47 
     48 (defface highlight-function-calls--not-face
     49   '((t (:inherit font-lock-negation-char-face)))
     50   "Face for highlighting `not'."
     51   :group 'highlight-function-calls)
     52 
     53 (defcustom highlight-function-calls-exclude-symbols
     54   '(
     55     =
     56     +
     57     -
     58     /
     59     *
     60     <
     61     >
     62     <=
     63     >=
     64     debug  ; Not intended as an interactive function
     65     error
     66     provide
     67     require
     68     signal
     69     throw
     70     user-error
     71     )
     72   "List of symbols to not highlight."
     73   :type '(repeat symbol))
     74 
     75 (defcustom highlight-function-calls-macro-calls nil
     76   "Whether to highlight macro calls."
     77   :type 'boolean)
     78 
     79 (defcustom highlight-function-calls-special-forms nil
     80   "Whether to highlight special-forms calls."
     81   :type 'boolean)
     82 
     83 (defcustom highlight-function-calls-not nil
     84   "Whether to highlight `not'."
     85   :type 'boolean)
     86 
     87 (defconst highlight-function-calls--keywords
     88   '((
     89      ;; First we match an opening paren, which prevents matching
     90      ;; function names as arguments.  We also avoid matching opening
     91      ;; parens immediately after quotes.
     92 
     93      ;; FIXME: This does not avoid matching opening parens in quoted
     94      ;; lists. I don't know if we can fix this, because `syntax-ppss'
     95      ;; doesn't give any information about this.  It might require
     96      ;; using semantic, which we probably don't want to mess with.
     97 
     98      ;; FIXME: It also doesn't avoid matching, e.g. the `map' in "(let
     99      ;; ((map".  I'm not sure why.
    100      "\\(?:^\\|[[:space:]]+\\|,\\)("  ; (rx (or bol (1+ space) ",") "(")
    101 
    102      ;; NOTE: The (0 nil) is required, although I don't understand
    103      ;; exactly why.  This was confusing enough, following the
    104      ;; docstring for `font-lock-add-keywords'.
    105      (0 nil)
    106 
    107      ;; Now we use a HIGHLIGHT MATCH-ANCHORED form to match the symbol
    108      ;; after the paren.  We call the `highlight-function-calls--matcher'
    109      ;; function to test whether the face should be applied.  We use a
    110      ;; PRE-MATCH-FORM to return a position at the end of the symbol,
    111      ;; which prevents matching function name symbols later on the
    112      ;; line, but we must not move the point in the process.  We do
    113      ;; not use a POST-MATCH-FORM.  Then we use the MATCH-HIGHLIGHT
    114      ;; form to highlight group 0, which is the whole symbol, we apply
    115      ;; the `highlight-function-calls-face' face, and we `prepend' it so
    116      ;; that it overrides existing faces; this way we even work with,
    117      ;; e.g. `rainbow-identifiers-mode', but only if we're activated
    118      ;; last.
    119      (highlight-function-calls--matcher
    120       (save-excursion
    121         (forward-symbol 1)
    122         (point))
    123       nil
    124       (0 highlight-function-calls--face-name prepend))))
    125   "Keywords argument for `font-lock-add-keywords'.")
    126 
    127 (defvar highlight-function-calls--face-name nil)
    128 
    129 (defun highlight-function-calls--matcher (end)
    130   "The matcher function to be used by font lock mode."
    131   (setq end (save-excursion (forward-symbol 1) (point)))
    132   (catch 'highlight-function-calls--matcher
    133     (when (not (nth 5 (syntax-ppss)))
    134       (while (re-search-forward (rx symbol-start (*? any) symbol-end) end t)
    135         (let ((match (intern-soft (match-string 0))))
    136           (when (and (or (functionp match)
    137                          (when highlight-function-calls-macro-calls
    138                            (macrop match))
    139                          (when highlight-function-calls-special-forms
    140                            (special-form-p match)))
    141                      (not (member match highlight-function-calls-exclude-symbols)))
    142             (goto-char (match-end 0))
    143             (setq highlight-function-calls--face-name
    144                   (pcase match
    145                     ((and (or 'not 'null) (guard highlight-function-calls-not)) 'highlight-function-calls--not-face)
    146                     (_ 'highlight-function-calls-face)))
    147             (throw 'highlight-function-calls--matcher t)))))
    148     nil))
    149 
    150 ;;;###autoload
    151 (define-minor-mode highlight-function-calls-mode
    152   "Highlight function calls.
    153 
    154 Toggle highlighting of function calls on or off.
    155 
    156 With a prefix argument ARG, enable if ARG is positive, and
    157 disable it otherwise. If called from Lisp, enable the mode if ARG
    158 is omitted or nil, and toggle it if ARG is `toggle'."
    159   :init-value nil :lighter nil :keymap nil
    160   (let ((keywords highlight-function-calls--keywords))
    161     (font-lock-remove-keywords nil keywords)
    162     (when highlight-function-calls-mode
    163       (font-lock-add-keywords nil keywords 'append)))
    164   ;; Refresh font locking.
    165   (when font-lock-mode
    166     (if (fboundp 'font-lock-flush)
    167         (font-lock-flush)
    168       (with-no-warnings (font-lock-fontify-buffer)))))
    169 
    170 (provide 'highlight-function-calls)
    171 
    172 ;;; highlight-function-calls.el ends here