code.delx.au - gnu-emacs/blob - lisp/progmodes/prog-mode.el

   1 ;;; prog-mode.el --- Generic major mode for programming  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: emacs-devel@gnu.org
   6 ;; Keywords: internal
   7 ;; Package: emacs
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This major mode is mostly intended as a parent of other programming
  27 ;; modes.  All major modes for programming languages should derive from this
  28 ;; mode so that users can put generic customization on prog-mode-hook.
  29
  30 ;;; Code:
  31
  32 (eval-when-compile (require 'cl-lib)
  33                    (require 'subr-x))
  34
  35 (defgroup prog-mode nil
  36   "Generic programming mode, from which others derive."
  37   :group 'languages)
  38
  39 (defcustom prog-mode-hook nil
  40   "Normal hook run when entering programming modes."
  41   :type 'hook
  42   :options '(flyspell-prog-mode abbrev-mode flymake-mode linum-mode
  43                                 prettify-symbols-mode)
  44   :group 'prog-mode)
  45
  46 (defvar prog-mode-map
  47   (let ((map (make-sparse-keymap)))
  48     (define-key map [?\C-\M-q] 'prog-indent-sexp)
  49     map)
  50   "Keymap used for programming modes.")
  51
  52 (defvar prog-indentation-context nil
  53   "Non-nil while indenting embedded code chunks.
  54 There are languages where part of the code is actually written in
  55 a sub language, e.g., a Yacc/Bison or ANTLR grammar also consists
  56 of plain C code.  This variable enables the major mode of the
  57 main language to use the indentation engine of the sub mode for
  58 lines in code chunks written in the sub language.
  59
  60 When a major mode of such a main language decides to delegate the
  61 indentation of a line/region to the indentation engine of the sub
  62 mode, it is supposed to bind this variable to non-nil around the call.
  63
  64 The non-nil value looks as follows
  65    (FIRST-COLUMN (START . END) PREVIOUS-CHUNKS)
  66
  67 FIRST-COLUMN is the column the indentation engine of the sub mode
  68 should usually choose for top-level language constructs inside
  69 the code chunk (instead of 0).
  70
  71 START to END is the region of the code chunk.  See function
  72 `prog-widen' for additional info.
  73
  74 PREVIOUS-CHUNKS, if non-nil, provides the indentation engine of
  75 the sub mode with the virtual context of the code chunk.  Valid
  76 values are:
  77
  78  - A string containing code which the indentation engine can
  79    consider as standing in front of the code chunk.  To cache the
  80    string's calculated syntactic information for repeated calls
  81    with the same string, it is valid and expected for the inner
  82    mode to add text-properties to the string.
  83
  84    A typical use case is for grammars with code chunks which are
  85    to be indented like function bodies - the string would contain
  86    a corresponding function header.
  87
  88  - A function called with the start position of the current
  89    chunk.  It will return either the region of the previous chunk
  90    as (PREV-START . PREV-END) or nil if there is no further
  91    previous chunk.
  92
  93    A typical use case are literate programming sources - the
  94    function would successively return the code chunks of the
  95    previous macro definitions for the same name.")
  96
  97 (defun prog-indent-sexp (&optional defun)
  98   "Indent the expression after point.
  99 When interactively called with prefix, indent the enclosing defun
 100 instead."
 101   (interactive "P")
 102   (save-excursion
 103     (when defun
 104       (end-of-line)
 105       (beginning-of-defun))
 106     (let ((start (point))
 107           (end (progn (forward-sexp 1) (point))))
 108       (indent-region start end nil))))
 109
 110 (defun prog-first-column ()
 111   "Return the indentation column normally used for top-level constructs."
 112   (or (car prog-indentation-context) 0))
 113
 114 (defun prog-widen ()
 115   "Remove restrictions (narrowing) from current code chunk or buffer.
 116 This function can be used instead of `widen' in any function used
 117 by the indentation engine to make it respect the value
 118 `prog-indentation-context'.
 119
 120 This function (like `widen') is useful inside a
 121 `save-restriction' to make the indentation correctly work when
 122 narrowing is in effect."
 123   (let ((chunk (cadr prog-indentation-context)))
 124     (if chunk
 125         ;; no widen necessary here, as narrow-to-region changes (not
 126         ;; just narrows) existing restrictions
 127         (narrow-to-region (car chunk) (or (cdr chunk) (point-max)))
 128       (widen))))
 129
 130
 131 (defvar-local prettify-symbols-alist nil
 132   "Alist of symbol prettifications.
 133 Each element looks like (SYMBOL . CHARACTER), where the symbol
 134 matching SYMBOL (a string, not a regexp) will be shown as
 135 CHARACTER instead.
 136
 137 CHARACTER can be a character or it can be a list or vector, in
 138 which case it will be used to compose the new symbol as per the
 139 third argument of `compose-region'.")
 140
 141 (defun prettify-symbols-default-compose-p (start end _match)
 142   "Return true iff the symbol MATCH should be composed.
 143 The symbol starts at position START and ends at position END.
 144 This is default `prettify-symbols-compose-predicate' which is
 145 suitable for most programming languages such as C or Lisp."
 146   ;; Check that the chars should really be composed into a symbol.
 147   (let* ((syntaxes-beg (if (memq (char-syntax (char-after start)) '(?w ?_))
 148                            '(?w ?_) '(?. ?\\)))
 149          (syntaxes-end (if (memq (char-syntax (char-before end)) '(?w ?_))
 150                            '(?w ?_) '(?. ?\\))))
 151     (not (or (memq (char-syntax (or (char-before start) ?\s)) syntaxes-beg)
 152              (memq (char-syntax (or (char-after end) ?\s)) syntaxes-end)
 153              (nth 8 (syntax-ppss))))))
 154
 155 (defvar-local prettify-symbols-compose-predicate
 156   #'prettify-symbols-default-compose-p
 157   "A predicate deciding if the currently matched symbol is to be composed.
 158 The matched symbol is the car of one entry in `prettify-symbols-alist'.
 159 The predicate receives the match's start and end position as well
 160 as the match-string as arguments.")
 161
 162 (defun prettify-symbols--compose-symbol (alist)
 163   "Compose a sequence of characters into a symbol.
 164 Regexp match data 0 points to the chars."
 165   ;; Check that the chars should really be composed into a symbol.
 166   (let ((start (match-beginning 0))
 167         (end (match-end 0))
 168         (match (match-string 0)))
 169     (if (and (not (equal prettify-symbols--current-symbol-bounds (list start end)))
 170              (funcall prettify-symbols-compose-predicate start end match))
 171         ;; That's a symbol alright, so add the composition.
 172         (with-silent-modifications
 173           (compose-region start end (cdr (assoc match alist)))
 174           (add-text-properties
 175            start end
 176            `(prettify-symbols-start ,start prettify-symbols-end ,end)))
 177       ;; No composition for you.  Let's actually remove any
 178       ;; composition we may have added earlier and which is now
 179       ;; incorrect.
 180       (remove-text-properties start end '(composition
 181                                           prettify-symbols-start
 182                                           prettify-symbols-end))))
 183   ;; Return nil because we're not adding any face property.
 184   nil)
 185
 186 (defun prettify-symbols--make-keywords ()
 187   (if prettify-symbols-alist
 188       `((,(regexp-opt (mapcar 'car prettify-symbols-alist) t)
 189          (0 (prettify-symbols--compose-symbol ',prettify-symbols-alist))))
 190     nil))
 191
 192 (defvar-local prettify-symbols--keywords nil)
 193
 194 (defvar-local prettify-symbols--current-symbol-bounds nil)
 195
 196 (defcustom prettify-symbols-unprettify-at-point nil
 197   "If non-nil, show the non-prettified version of a symbol when point is on it.
 198 If set to the symbol `right-edge', also unprettify if point
 199 is immediately after the symbol.  The prettification will be
 200 reapplied as soon as point moves away from the symbol.  If
 201 set to nil, the prettification persists even when point is
 202 on the symbol."
 203   :type '(choice (const :tag "Never unprettify" nil)
 204                  (const :tag "Unprettify when point is inside" t)
 205                  (const :tag "Unprettify when point is inside or at right edge" right-edge))
 206   :group 'prog-mode)
 207
 208 (defun prettify-symbols--post-command-hook ()
 209   (cl-labels ((get-prop-as-list
 210                (prop)
 211                (remove nil
 212                        (list (get-text-property (point) prop)
 213                              (when (and (eq prettify-symbols-unprettify-at-point 'right-edge)
 214                                         (not (bobp)))
 215                                (get-text-property (1- (point)) prop))))))
 216     ;; Re-apply prettification to the previous symbol.
 217     (when (and prettify-symbols--current-symbol-bounds
 218                (or (< (point) (car prettify-symbols--current-symbol-bounds))
 219                    (> (point) (cadr prettify-symbols--current-symbol-bounds))
 220                    (and (not (eq prettify-symbols-unprettify-at-point 'right-edge))
 221                         (= (point) (cadr prettify-symbols--current-symbol-bounds)))))
 222       (apply #'font-lock-flush prettify-symbols--current-symbol-bounds)
 223       (setq prettify-symbols--current-symbol-bounds nil))
 224     ;; Unprettify the current symbol.
 225     (when-let ((c (get-prop-as-list 'composition))
 226                (s (get-prop-as-list 'prettify-symbols-start))
 227                (e (get-prop-as-list 'prettify-symbols-end))
 228                (s (apply #'min s))
 229                (e (apply #'max e)))
 230       (with-silent-modifications
 231         (setq prettify-symbols--current-symbol-bounds (list s e))
 232         (remove-text-properties s e '(composition))))))
 233
 234 ;;;###autoload
 235 (define-minor-mode prettify-symbols-mode
 236   "Toggle Prettify Symbols mode.
 237 With a prefix argument ARG, enable Prettify Symbols mode if ARG is
 238 positive, and disable it otherwise.  If called from Lisp, enable
 239 the mode if ARG is omitted or nil.
 240
 241 When Prettify Symbols mode and font-locking are enabled, symbols are
 242 prettified (displayed as composed characters) according to the rules
 243 in `prettify-symbols-alist' (which see), which are locally defined
 244 by major modes supporting prettifying.  To add further customizations
 245 for a given major mode, you can modify `prettify-symbols-alist' thus:
 246
 247   (add-hook \\='emacs-lisp-mode-hook
 248             (lambda ()
 249               (push \\='(\"<=\" . ?≤) prettify-symbols-alist)))
 250
 251 You can enable this mode locally in desired buffers, or use
 252 `global-prettify-symbols-mode' to enable it for all modes that
 253 support it."
 254   :init-value nil
 255   (if prettify-symbols-mode
 256       ;; Turn on
 257       (when (setq prettify-symbols--keywords (prettify-symbols--make-keywords))
 258         (font-lock-add-keywords nil prettify-symbols--keywords)
 259         (setq-local font-lock-extra-managed-props
 260                     (append font-lock-extra-managed-props
 261                             '(composition
 262                               prettify-symbols-start
 263                               prettify-symbols-end)))
 264         (when prettify-symbols-unprettify-at-point
 265           (add-hook 'post-command-hook
 266                     #'prettify-symbols--post-command-hook nil t))
 267         (font-lock-flush))
 268     ;; Turn off
 269     (remove-hook 'post-command-hook #'prettify-symbols--post-command-hook t)
 270     (when prettify-symbols--keywords
 271       (font-lock-remove-keywords nil prettify-symbols--keywords)
 272       (setq prettify-symbols--keywords nil))
 273     (when (memq 'composition font-lock-extra-managed-props)
 274       (setq font-lock-extra-managed-props (delq 'composition
 275                                                 font-lock-extra-managed-props))
 276       (with-silent-modifications
 277         (remove-text-properties (point-min) (point-max) '(composition nil))))))
 278
 279 (defun turn-on-prettify-symbols-mode ()
 280   (when (and (not prettify-symbols-mode)
 281              (local-variable-p 'prettify-symbols-alist))
 282     (prettify-symbols-mode 1)))
 283
 284 ;;;###autoload
 285 (define-globalized-minor-mode global-prettify-symbols-mode
 286   prettify-symbols-mode turn-on-prettify-symbols-mode)
 287
 288 ;;;###autoload
 289 (define-derived-mode prog-mode fundamental-mode "Prog"
 290   "Major mode for editing programming language source code."
 291   (setq-local require-final-newline mode-require-final-newline)
 292   (setq-local parse-sexp-ignore-comments t)
 293   ;; Any programming language is always written left to right.
 294   (setq bidi-paragraph-direction 'left-to-right))
 295
 296 (provide 'prog-mode)
 297
 298 ;;; prog-mode.el ends here