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   "When non-nil, provides context for indenting embedded code chunks.
  54
  55 There are languages where part of the code is actually written in
  56 a sub language, e.g., a Yacc/Bison or ANTLR grammar also consists
  57 of plain C code.  This variable enables the major mode of the
  58 main language to use the indentation engine of the sub-mode for
  59 lines in code chunks written in the sub-mode's language.
  60
  61 When a major mode of such a main language decides to delegate the
  62 indentation of a line/region to the indentation engine of the sub
  63 mode, it should bind this variable to non-nil around the call.
  64
  65 The non-nil value should be a list of the form:
  66
  67    (FIRST-COLUMN (START . END) PREVIOUS-CHUNKS)
  68
  69 FIRST-COLUMN is the column the indentation engine of the sub-mode
  70 should use for top-level language constructs inside the code
  71 chunk (instead of 0).
  72
  73 START and END specify the region of the code chunk.  END can be
  74 nil, which stands for the value of `point-max'.  The function
  75 `prog-widen' uses this to restore restrictions imposed by the
  76 sub-mode's indentation engine.
  77
  78 PREVIOUS-CHUNKS, if non-nil, provides the indentation engine of
  79 the sub-mode with the virtual context of the code chunk.  Valid
  80 values are:
  81
  82  - A string containing text which the indentation engine can
  83    consider as standing in front of the code chunk.  To cache the
  84    string's calculated syntactic information for repeated calls
  85    with the same string, the sub-mode can add text-properties to
  86    the string.
  87
  88    A typical use case is for grammars with code chunks which are
  89    to be indented like function bodies -- the string would contain
  90    the corresponding function preamble.
  91
  92  - A function, to be called with the start position of the current
  93    chunk.  It should return either the region of the previous chunk
  94    as (PREV-START . PREV-END), or nil if there is no previous chunk.
  95
  96    A typical use case are literate programming sources -- the
  97    function would successively return the previous code chunks.")
  98
  99 (defun prog-indent-sexp (&optional defun)
 100   "Indent the expression after point.
 101 When interactively called with prefix, indent the enclosing defun
 102 instead."
 103   (interactive "P")
 104   (save-excursion
 105     (when defun
 106       (end-of-line)
 107       (beginning-of-defun))
 108     (let ((start (point))
 109           (end (progn (forward-sexp 1) (point))))
 110       (indent-region start end nil))))
 111
 112 (defun prog-first-column ()
 113   "Return the indentation column normally used for top-level constructs."
 114   (or (car prog-indentation-context) 0))
 115
 116 (defun prog-widen ()
 117   "Remove restrictions (narrowing) from current code chunk or buffer.
 118 This function should be used instead of `widen' in any function used
 119 by the indentation engine to make it respect the value of
 120 `prog-indentation-context'.
 121
 122 This function (like `widen') is useful inside a
 123 `save-restriction' to make the indentation correctly work when
 124 narrowing is in effect."
 125   (let ((chunk (cadr prog-indentation-context)))
 126     (if chunk
 127         ;; No call to `widen' is necessary here, as narrow-to-region
 128         ;; changes (not just narrows) the existing restrictions
 129         (narrow-to-region (car chunk) (or (cdr chunk) (point-max)))
 130       (widen))))
 131
 132
 133 (defvar-local prettify-symbols-alist nil
 134   "Alist of symbol prettifications.
 135 Each element looks like (SYMBOL . CHARACTER), where the symbol
 136 matching SYMBOL (a string, not a regexp) will be shown as
 137 CHARACTER instead.
 138
 139 CHARACTER can be a character, or it can be a list or vector, in
 140 which case it will be used to compose the new symbol as per the
 141 third argument of `compose-region'.")
 142
 143 (defun prettify-symbols-default-compose-p (start end _match)
 144   "Return true iff the symbol MATCH should be composed.
 145 The symbol starts at position START and ends at position END.
 146 This is the default for `prettify-symbols-compose-predicate'
 147 which is suitable for most programming languages such as C or Lisp."
 148   ;; Check that the chars should really be composed into a symbol.
 149   (let* ((syntaxes-beg (if (memq (char-syntax (char-after start)) '(?w ?_))
 150                            '(?w ?_) '(?. ?\\)))
 151          (syntaxes-end (if (memq (char-syntax (char-before end)) '(?w ?_))
 152                            '(?w ?_) '(?. ?\\))))
 153     (not (or (memq (char-syntax (or (char-before start) ?\s)) syntaxes-beg)
 154              (memq (char-syntax (or (char-after end) ?\s)) syntaxes-end)
 155              (nth 8 (syntax-ppss))))))
 156
 157 (defvar-local prettify-symbols-compose-predicate
 158   #'prettify-symbols-default-compose-p
 159   "A predicate for deciding if the currently matched symbol is to be composed.
 160 The matched symbol is the car of one entry in `prettify-symbols-alist'.
 161 The predicate receives the match's start and end positions as well
 162 as the match-string as arguments.")
 163
 164 (defun prettify-symbols--compose-symbol (alist)
 165   "Compose a sequence of characters into a symbol.
 166 Regexp match data 0 specifies the characters to be composed."
 167   ;; Check that the chars should really be composed into a symbol.
 168   (let ((start (match-beginning 0))
 169         (end (match-end 0))
 170         (match (match-string 0)))
 171     (if (and (not (equal prettify-symbols--current-symbol-bounds (list start end)))
 172              (funcall prettify-symbols-compose-predicate start end match))
 173         ;; That's a symbol alright, so add the composition.
 174         (with-silent-modifications
 175           (compose-region start end (cdr (assoc match alist)))
 176           (add-text-properties
 177            start end
 178            `(prettify-symbols-start ,start prettify-symbols-end ,end)))
 179       ;; No composition for you.  Let's actually remove any
 180       ;; composition we may have added earlier and which is now
 181       ;; incorrect.
 182       (remove-text-properties start end '(composition
 183                                           prettify-symbols-start
 184                                           prettify-symbols-end))))
 185   ;; Return nil because we're not adding any face property.
 186   nil)
 187
 188 (defun prettify-symbols--make-keywords ()
 189   (if prettify-symbols-alist
 190       `((,(regexp-opt (mapcar 'car prettify-symbols-alist) t)
 191          (0 (prettify-symbols--compose-symbol ',prettify-symbols-alist))))
 192     nil))
 193
 194 (defvar-local prettify-symbols--keywords nil)
 195
 196 (defvar-local prettify-symbols--current-symbol-bounds nil)
 197
 198 (defcustom prettify-symbols-unprettify-at-point nil
 199   "If non-nil, show the non-prettified version of a symbol when point is on it.
 200 If set to the symbol `right-edge', also unprettify if point
 201 is immediately after the symbol.  The prettification will be
 202 reapplied as soon as point moves away from the symbol.  If
 203 set to nil, the prettification persists even when point is
 204 on the symbol."
 205   :type '(choice (const :tag "Never unprettify" nil)
 206                  (const :tag "Unprettify when point is inside" t)
 207                  (const :tag "Unprettify when point is inside or at right edge" right-edge))
 208   :group 'prog-mode)
 209
 210 (defun prettify-symbols--post-command-hook ()
 211   (cl-labels ((get-prop-as-list
 212                (prop)
 213                (remove nil
 214                        (list (get-text-property (point) prop)
 215                              (when (and (eq prettify-symbols-unprettify-at-point 'right-edge)
 216                                         (not (bobp)))
 217                                (get-text-property (1- (point)) prop))))))
 218     ;; Re-apply prettification to the previous symbol.
 219     (when (and prettify-symbols--current-symbol-bounds
 220                (or (< (point) (car prettify-symbols--current-symbol-bounds))
 221                    (> (point) (cadr prettify-symbols--current-symbol-bounds))
 222                    (and (not (eq prettify-symbols-unprettify-at-point 'right-edge))
 223                         (= (point) (cadr prettify-symbols--current-symbol-bounds)))))
 224       (apply #'font-lock-flush prettify-symbols--current-symbol-bounds)
 225       (setq prettify-symbols--current-symbol-bounds nil))
 226     ;; Unprettify the current symbol.
 227     (when-let ((c (get-prop-as-list 'composition))
 228                (s (get-prop-as-list 'prettify-symbols-start))
 229                (e (get-prop-as-list 'prettify-symbols-end))
 230                (s (apply #'min s))
 231                (e (apply #'max e)))
 232       (with-silent-modifications
 233         (setq prettify-symbols--current-symbol-bounds (list s e))
 234         (remove-text-properties s e '(composition))))))
 235
 236 ;;;###autoload
 237 (define-minor-mode prettify-symbols-mode
 238   "Toggle Prettify Symbols mode.
 239 With a prefix argument ARG, enable Prettify Symbols mode if ARG is
 240 positive, and disable it otherwise.  If called from Lisp, enable
 241 the mode if ARG is omitted or nil.
 242
 243 When Prettify Symbols mode and font-locking are enabled, symbols are
 244 prettified (displayed as composed characters) according to the rules
 245 in `prettify-symbols-alist' (which see), which are locally defined
 246 by major modes supporting prettifying.  To add further customizations
 247 for a given major mode, you can modify `prettify-symbols-alist' thus:
 248
 249   (add-hook \\='emacs-lisp-mode-hook
 250             (lambda ()
 251               (push \\='(\"<=\" . ?≤) prettify-symbols-alist)))
 252
 253 You can enable this mode locally in desired buffers, or use
 254 `global-prettify-symbols-mode' to enable it for all modes that
 255 support it."
 256   :init-value nil
 257   (if prettify-symbols-mode
 258       ;; Turn on
 259       (when (setq prettify-symbols--keywords (prettify-symbols--make-keywords))
 260         (font-lock-add-keywords nil prettify-symbols--keywords)
 261         (setq-local font-lock-extra-managed-props
 262                     (append font-lock-extra-managed-props
 263                             '(composition
 264                               prettify-symbols-start
 265                               prettify-symbols-end)))
 266         (when prettify-symbols-unprettify-at-point
 267           (add-hook 'post-command-hook
 268                     #'prettify-symbols--post-command-hook nil t))
 269         (font-lock-flush))
 270     ;; Turn off
 271     (remove-hook 'post-command-hook #'prettify-symbols--post-command-hook t)
 272     (when prettify-symbols--keywords
 273       (font-lock-remove-keywords nil prettify-symbols--keywords)
 274       (setq prettify-symbols--keywords nil))
 275     (when (memq 'composition font-lock-extra-managed-props)
 276       (setq font-lock-extra-managed-props (delq 'composition
 277                                                 font-lock-extra-managed-props))
 278       (with-silent-modifications
 279         (remove-text-properties (point-min) (point-max) '(composition nil))))))
 280
 281 (defun turn-on-prettify-symbols-mode ()
 282   (when (and (not prettify-symbols-mode)
 283              (local-variable-p 'prettify-symbols-alist))
 284     (prettify-symbols-mode 1)))
 285
 286 ;;;###autoload
 287 (define-globalized-minor-mode global-prettify-symbols-mode
 288   prettify-symbols-mode turn-on-prettify-symbols-mode)
 289
 290 ;;;###autoload
 291 (define-derived-mode prog-mode fundamental-mode "Prog"
 292   "Major mode for editing programming language source code."
 293   (setq-local require-final-newline mode-require-final-newline)
 294   (setq-local parse-sexp-ignore-comments t)
 295   ;; Any programming language is always written left to right.
 296   (setq bidi-paragraph-direction 'left-to-right))
 297
 298 (provide 'prog-mode)
 299
 300 ;;; prog-mode.el ends here