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 (defun prettify-symbols-default-compose-p (start end _match)
 138   "Return true iff the symbol MATCH should be composed.
 139 The symbol starts at position START and ends at position END.
 140 This is default `prettify-symbols-compose-predicate' which is
 141 suitable for most programming languages such as C or Lisp."
 142   ;; Check that the chars should really be composed into a symbol.
 143   (let* ((syntaxes-beg (if (memq (char-syntax (char-after start)) '(?w ?_))
 144                            '(?w ?_) '(?. ?\\)))
 145          (syntaxes-end (if (memq (char-syntax (char-before end)) '(?w ?_))
 146                            '(?w ?_) '(?. ?\\))))
 147     (not (or (memq (char-syntax (or (char-before start) ?\s)) syntaxes-beg)
 148              (memq (char-syntax (or (char-after end) ?\s)) syntaxes-end)
 149              (nth 8 (syntax-ppss))))))
 150
 151 (defvar-local prettify-symbols-compose-predicate
 152   #'prettify-symbols-default-compose-p
 153   "A predicate deciding if the currently matched symbol is to be composed.
 154 The matched symbol is the car of one entry in `prettify-symbols-alist'.
 155 The predicate receives the match's start and end position as well
 156 as the match-string as arguments.")
 157
 158 (defun prettify-symbols--compose-symbol (alist)
 159   "Compose a sequence of characters into a symbol.
 160 Regexp match data 0 points to the chars."
 161   ;; Check that the chars should really be composed into a symbol.
 162   (let ((start (match-beginning 0))
 163         (end (match-end 0))
 164         (match (match-string 0)))
 165     (if (and (not (equal prettify-symbols--current-symbol-bounds (list start end)))
 166              (funcall prettify-symbols-compose-predicate start end match))
 167         ;; That's a symbol alright, so add the composition.
 168         (with-silent-modifications
 169           (compose-region start end (cdr (assoc match alist)))
 170           (add-text-properties
 171            start end
 172            `(prettify-symbols-start ,start prettify-symbols-end ,end)))
 173       ;; No composition for you.  Let's actually remove any
 174       ;; composition we may have added earlier and which is now
 175       ;; incorrect.
 176       (remove-text-properties start end '(composition
 177                                           prettify-symbols-start
 178                                           prettify-symbols-end))))
 179   ;; Return nil because we're not adding any face property.
 180   nil)
 181
 182 (defun prettify-symbols--make-keywords ()
 183   (if prettify-symbols-alist
 184       `((,(regexp-opt (mapcar 'car prettify-symbols-alist) t)
 185          (0 (prettify-symbols--compose-symbol ',prettify-symbols-alist))))
 186     nil))
 187
 188 (defvar-local prettify-symbols--keywords nil)
 189
 190 (defvar-local prettify-symbols--current-symbol-bounds nil)
 191
 192 (defcustom prettify-symbols-unprettify-at-point nil
 193   "If non-nil, show the non-prettified version of a symbol when point is on it.
 194 If set to the symbol `right-edge', also unprettify if point
 195 is immediately after the symbol.  The prettification will be
 196 reapplied as soon as point moves away from the symbol.  If
 197 set to nil, the prettification persists even when point is
 198 on the symbol."
 199   :type '(choice (const :tag "Never unprettify" nil)
 200                  (const :tag "Unprettify when point is inside" t)
 201                  (const :tag "Unprettify when point is inside or at right edge" right-edge))
 202   :group 'prog-mode)
 203
 204 (defun prettify-symbols--post-command-hook ()
 205   (cl-labels ((get-prop-as-list
 206                (prop)
 207                (remove nil
 208                        (list (get-text-property (point) prop)
 209                              (when (and (eq prettify-symbols-unprettify-at-point 'right-edge)
 210                                         (not (bobp)))
 211                                (get-text-property (1- (point)) prop))))))
 212     ;; Re-apply prettification to the previous symbol.
 213     (when (and prettify-symbols--current-symbol-bounds
 214                (or (< (point) (car prettify-symbols--current-symbol-bounds))
 215                    (> (point) (cadr prettify-symbols--current-symbol-bounds))
 216                    (and (not (eq prettify-symbols-unprettify-at-point 'right-edge))
 217                         (= (point) (cadr prettify-symbols--current-symbol-bounds)))))
 218       (apply #'font-lock-flush prettify-symbols--current-symbol-bounds)
 219       (setq prettify-symbols--current-symbol-bounds nil))
 220     ;; Unprettify the current symbol.
 221     (when-let ((c (get-prop-as-list 'composition))
 222                (s (get-prop-as-list 'prettify-symbols-start))
 223                (e (get-prop-as-list 'prettify-symbols-end))
 224                (s (apply #'min s))
 225                (e (apply #'max e)))
 226       (with-silent-modifications
 227         (setq prettify-symbols--current-symbol-bounds (list s e))
 228         (remove-text-properties s e '(composition))))))
 229
 230 ;;;###autoload
 231 (define-minor-mode prettify-symbols-mode
 232   "Toggle Prettify Symbols mode.
 233 With a prefix argument ARG, enable Prettify Symbols mode if ARG is
 234 positive, and disable it otherwise.  If called from Lisp, enable
 235 the mode if ARG is omitted or nil.
 236
 237 When Prettify Symbols mode and font-locking are enabled, symbols are
 238 prettified (displayed as composed characters) according to the rules
 239 in `prettify-symbols-alist' (which see), which are locally defined
 240 by major modes supporting prettifying.  To add further customizations
 241 for a given major mode, you can modify `prettify-symbols-alist' thus:
 242
 243   (add-hook \\='emacs-lisp-mode-hook
 244             (lambda ()
 245               (push \\='(\"<=\" . ?≤) prettify-symbols-alist)))
 246
 247 You can enable this mode locally in desired buffers, or use
 248 `global-prettify-symbols-mode' to enable it for all modes that
 249 support it."
 250   :init-value nil
 251   (if prettify-symbols-mode
 252       ;; Turn on
 253       (when (setq prettify-symbols--keywords (prettify-symbols--make-keywords))
 254         (font-lock-add-keywords nil prettify-symbols--keywords)
 255         (setq-local font-lock-extra-managed-props
 256                     (append font-lock-extra-managed-props
 257                             '(composition
 258                               prettify-symbols-start
 259                               prettify-symbols-end)))
 260         (when prettify-symbols-unprettify-at-point
 261           (add-hook 'post-command-hook
 262                     #'prettify-symbols--post-command-hook nil t))
 263         (font-lock-flush))
 264     ;; Turn off
 265     (remove-hook 'post-command-hook #'prettify-symbols--post-command-hook t)
 266     (when prettify-symbols--keywords
 267       (font-lock-remove-keywords nil prettify-symbols--keywords)
 268       (setq prettify-symbols--keywords nil))
 269     (when (memq 'composition font-lock-extra-managed-props)
 270       (setq font-lock-extra-managed-props (delq 'composition
 271                                                 font-lock-extra-managed-props))
 272       (with-silent-modifications
 273         (remove-text-properties (point-min) (point-max) '(composition nil))))))
 274
 275 (defun turn-on-prettify-symbols-mode ()
 276   (when (and (not prettify-symbols-mode)
 277              (local-variable-p 'prettify-symbols-alist))
 278     (prettify-symbols-mode 1)))
 279
 280 ;;;###autoload
 281 (define-globalized-minor-mode global-prettify-symbols-mode
 282   prettify-symbols-mode turn-on-prettify-symbols-mode)
 283
 284 ;;;###autoload
 285 (define-derived-mode prog-mode fundamental-mode "Prog"
 286   "Major mode for editing programming language source code."
 287   (setq-local require-final-newline mode-require-final-newline)
 288   (setq-local parse-sexp-ignore-comments t)
 289   ;; Any programming language is always written left to right.
 290   (setq bidi-paragraph-direction 'left-to-right))
 291
 292 (provide 'prog-mode)
 293
 294 ;;; prog-mode.el ends here