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-2016 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 (defun prog-indent-sexp (&optional defun)
  53   "Indent the expression after point.
  54 When interactively called with prefix, indent the enclosing defun
  55 instead."
  56   (interactive "P")
  57   (save-excursion
  58     (when defun
  59       (end-of-line)
  60       (beginning-of-defun))
  61     (let ((start (point))
  62           (end (progn (forward-sexp 1) (point))))
  63       (indent-region start end nil))))
  64
  65 (defvar-local prettify-symbols-alist nil
  66   "Alist of symbol prettifications.
  67 Each element looks like (SYMBOL . CHARACTER), where the symbol
  68 matching SYMBOL (a string, not a regexp) will be shown as
  69 CHARACTER instead.
  70
  71 CHARACTER can be a character, or it can be a list or vector, in
  72 which case it will be used to compose the new symbol as per the
  73 third argument of `compose-region'.")
  74
  75 (defun prettify-symbols-default-compose-p (start end _match)
  76   "Return true iff the symbol MATCH should be composed.
  77 The symbol starts at position START and ends at position END.
  78 This is the default for `prettify-symbols-compose-predicate'
  79 which is suitable for most programming languages such as C or Lisp."
  80   ;; Check that the chars should really be composed into a symbol.
  81   (let* ((syntaxes-beg (if (memq (char-syntax (char-after start)) '(?w ?_))
  82                            '(?w ?_) '(?. ?\\)))
  83          (syntaxes-end (if (memq (char-syntax (char-before end)) '(?w ?_))
  84                            '(?w ?_) '(?. ?\\))))
  85     (not (or (memq (char-syntax (or (char-before start) ?\s)) syntaxes-beg)
  86              (memq (char-syntax (or (char-after end) ?\s)) syntaxes-end)
  87              (nth 8 (syntax-ppss))))))
  88
  89 (defvar-local prettify-symbols-compose-predicate
  90   #'prettify-symbols-default-compose-p
  91   "A predicate for deciding if the currently matched symbol is to be composed.
  92 The matched symbol is the car of one entry in `prettify-symbols-alist'.
  93 The predicate receives the match's start and end positions as well
  94 as the match-string as arguments.")
  95
  96 (defun prettify-symbols--compose-symbol (alist)
  97   "Compose a sequence of characters into a symbol.
  98 Regexp match data 0 specifies the characters to be composed."
  99   ;; Check that the chars should really be composed into a symbol.
 100   (let ((start (match-beginning 0))
 101         (end (match-end 0))
 102         (match (match-string 0)))
 103     (if (and (not (equal prettify-symbols--current-symbol-bounds (list start end)))
 104              (funcall prettify-symbols-compose-predicate start end match))
 105         ;; That's a symbol alright, so add the composition.
 106         (with-silent-modifications
 107           (compose-region start end (cdr (assoc match alist)))
 108           (add-text-properties
 109            start end
 110            `(prettify-symbols-start ,start prettify-symbols-end ,end)))
 111       ;; No composition for you.  Let's actually remove any
 112       ;; composition we may have added earlier and which is now
 113       ;; incorrect.
 114       (remove-text-properties start end '(composition
 115                                           prettify-symbols-start
 116                                           prettify-symbols-end))))
 117   ;; Return nil because we're not adding any face property.
 118   nil)
 119
 120 (defun prettify-symbols--make-keywords ()
 121   (if prettify-symbols-alist
 122       `((,(regexp-opt (mapcar 'car prettify-symbols-alist) t)
 123          (0 (prettify-symbols--compose-symbol ',prettify-symbols-alist))))
 124     nil))
 125
 126 (defvar-local prettify-symbols--keywords nil)
 127
 128 (defvar-local prettify-symbols--current-symbol-bounds nil)
 129
 130 (defcustom prettify-symbols-unprettify-at-point nil
 131   "If non-nil, show the non-prettified version of a symbol when point is on it.
 132 If set to the symbol `right-edge', also unprettify if point
 133 is immediately after the symbol.  The prettification will be
 134 reapplied as soon as point moves away from the symbol.  If
 135 set to nil, the prettification persists even when point is
 136 on the symbol."
 137   :version "25.1"
 138   :type '(choice (const :tag "Never unprettify" nil)
 139                  (const :tag "Unprettify when point is inside" t)
 140                  (const :tag "Unprettify when point is inside or at right edge" right-edge))
 141   :group 'prog-mode)
 142
 143 (defun prettify-symbols--post-command-hook ()
 144   (cl-labels ((get-prop-as-list
 145                (prop)
 146                (remove nil
 147                        (list (get-text-property (point) prop)
 148                              (when (and (eq prettify-symbols-unprettify-at-point 'right-edge)
 149                                         (not (bobp)))
 150                                (get-text-property (1- (point)) prop))))))
 151     ;; Re-apply prettification to the previous symbol.
 152     (when (and prettify-symbols--current-symbol-bounds
 153                (or (< (point) (car prettify-symbols--current-symbol-bounds))
 154                    (> (point) (cadr prettify-symbols--current-symbol-bounds))
 155                    (and (not (eq prettify-symbols-unprettify-at-point 'right-edge))
 156                         (= (point) (cadr prettify-symbols--current-symbol-bounds)))))
 157       (apply #'font-lock-flush prettify-symbols--current-symbol-bounds)
 158       (setq prettify-symbols--current-symbol-bounds nil))
 159     ;; Unprettify the current symbol.
 160     (when-let ((c (get-prop-as-list 'composition))
 161                (s (get-prop-as-list 'prettify-symbols-start))
 162                (e (get-prop-as-list 'prettify-symbols-end))
 163                (s (apply #'min s))
 164                (e (apply #'max e)))
 165       (with-silent-modifications
 166         (setq prettify-symbols--current-symbol-bounds (list s e))
 167         (remove-text-properties s e '(composition))))))
 168
 169 ;;;###autoload
 170 (define-minor-mode prettify-symbols-mode
 171   "Toggle Prettify Symbols mode.
 172 With a prefix argument ARG, enable Prettify Symbols mode if ARG is
 173 positive, and disable it otherwise.  If called from Lisp, enable
 174 the mode if ARG is omitted or nil.
 175
 176 When Prettify Symbols mode and font-locking are enabled, symbols are
 177 prettified (displayed as composed characters) according to the rules
 178 in `prettify-symbols-alist' (which see), which are locally defined
 179 by major modes supporting prettifying.  To add further customizations
 180 for a given major mode, you can modify `prettify-symbols-alist' thus:
 181
 182   (add-hook \\='emacs-lisp-mode-hook
 183             (lambda ()
 184               (push \\='(\"<=\" . ?≤) prettify-symbols-alist)))
 185
 186 You can enable this mode locally in desired buffers, or use
 187 `global-prettify-symbols-mode' to enable it for all modes that
 188 support it."
 189   :init-value nil
 190   (if prettify-symbols-mode
 191       ;; Turn on
 192       (when (setq prettify-symbols--keywords (prettify-symbols--make-keywords))
 193         (font-lock-add-keywords nil prettify-symbols--keywords)
 194         (setq-local font-lock-extra-managed-props
 195                     (append font-lock-extra-managed-props
 196                             '(composition
 197                               prettify-symbols-start
 198                               prettify-symbols-end)))
 199         (when prettify-symbols-unprettify-at-point
 200           (add-hook 'post-command-hook
 201                     #'prettify-symbols--post-command-hook nil t))
 202         (font-lock-flush))
 203     ;; Turn off
 204     (remove-hook 'post-command-hook #'prettify-symbols--post-command-hook t)
 205     (when prettify-symbols--keywords
 206       (font-lock-remove-keywords nil prettify-symbols--keywords)
 207       (setq prettify-symbols--keywords nil))
 208     (when (memq 'composition font-lock-extra-managed-props)
 209       (setq font-lock-extra-managed-props (delq 'composition
 210                                                 font-lock-extra-managed-props))
 211       (with-silent-modifications
 212         (remove-text-properties (point-min) (point-max) '(composition nil))))))
 213
 214 (defun turn-on-prettify-symbols-mode ()
 215   (when (and (not prettify-symbols-mode)
 216              (local-variable-p 'prettify-symbols-alist))
 217     (prettify-symbols-mode 1)))
 218
 219 ;;;###autoload
 220 (define-globalized-minor-mode global-prettify-symbols-mode
 221   prettify-symbols-mode turn-on-prettify-symbols-mode)
 222
 223 ;;;###autoload
 224 (define-derived-mode prog-mode fundamental-mode "Prog"
 225   "Major mode for editing programming language source code."
 226   (setq-local require-final-newline mode-require-final-newline)
 227   (setq-local parse-sexp-ignore-comments t)
 228   ;; Any programming language is always written left to right.
 229   (setq bidi-paragraph-direction 'left-to-right))
 230
 231 (provide 'prog-mode)
 232
 233 ;;; prog-mode.el ends here