LCOV - code coverage report
Current view: top level - lisp - abbrev.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 23 422 5.5 %
Date: 2017-08-27 09:44:50 Functions: 4 54 7.4 %

          Line data    Source code
       1             : ;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 1985-1987, 1992, 2001-2017 Free Software Foundation,
       4             : ;; Inc.
       5             : 
       6             : ;; Maintainer: emacs-devel@gnu.org
       7             : ;; Keywords: abbrev convenience
       8             : ;; Package: emacs
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU General Public License for more details.
      21             : 
      22             : ;; You should have received a copy of the GNU General Public License
      23             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;; This facility is documented in the Emacs Manual.
      28             : 
      29             : ;; Todo:
      30             : 
      31             : ;; - Cleanup name space.
      32             : 
      33             : ;;; Code:
      34             : 
      35             : (eval-when-compile (require 'cl-lib))
      36             : (require 'obarray)
      37             : 
      38             : (defgroup abbrev-mode nil
      39             :   "Word abbreviations mode."
      40             :   :link '(custom-manual "(emacs)Abbrevs")
      41             :   :group 'abbrev)
      42             : 
      43             : (defcustom abbrev-file-name
      44             :   (locate-user-emacs-file "abbrev_defs" ".abbrev_defs")
      45             :   "Default name of file from which to read abbrevs."
      46             :   :initialize 'custom-initialize-delay
      47             :   :type 'file)
      48             : 
      49             : (defcustom only-global-abbrevs nil
      50             :   "Non-nil means user plans to use global abbrevs only.
      51             : This makes the commands that normally define mode-specific abbrevs
      52             : define global abbrevs instead."
      53             :   :type 'boolean
      54             :   :group 'abbrev-mode
      55             :   :group 'convenience)
      56             : 
      57             : (define-minor-mode abbrev-mode
      58             :   "Toggle Abbrev mode in the current buffer.
      59             : With a prefix argument ARG, enable Abbrev mode if ARG is
      60             : positive, and disable it otherwise.  If called from Lisp, enable
      61             : Abbrev mode if ARG is omitted or nil.
      62             : 
      63             : In Abbrev mode, inserting an abbreviation causes it to expand and
      64             : be replaced by its expansion."
      65             :   ;; It's defined in C, this stops the d-m-m macro defining it again.
      66             :   :variable abbrev-mode)
      67             : 
      68             : (put 'abbrev-mode 'safe-local-variable 'booleanp)
      69             : 
      70             : 
      71             : (defvar edit-abbrevs-mode-map
      72             :   (let ((map (make-sparse-keymap)))
      73             :     (define-key map "\C-x\C-s" 'abbrev-edit-save-buffer)
      74             :     (define-key map "\C-x\C-w" 'abbrev-edit-save-to-file)
      75             :     (define-key map "\C-c\C-c" 'edit-abbrevs-redefine)
      76             :     map)
      77             :   "Keymap used in `edit-abbrevs'.")
      78             : (define-obsolete-variable-alias 'edit-abbrevs-map
      79             :   'edit-abbrevs-mode-map "24.4")
      80             : 
      81             : (defun kill-all-abbrevs ()
      82             :   "Undefine all defined abbrevs."
      83             :   (interactive)
      84           0 :   (dolist (tablesym abbrev-table-name-list)
      85           0 :     (clear-abbrev-table (symbol-value tablesym))))
      86             : 
      87             : (defun copy-abbrev-table (table)
      88             :   "Make a new abbrev-table with the same abbrevs as TABLE.
      89             : Does not copy property lists."
      90           0 :   (let ((new-table (make-abbrev-table)))
      91           0 :     (obarray-map
      92             :      (lambda (symbol)
      93           0 :        (define-abbrev new-table
      94           0 :          (symbol-name symbol)
      95           0 :          (symbol-value symbol)
      96           0 :          (symbol-function symbol)))
      97           0 :      table)
      98           0 :     new-table))
      99             : 
     100             : (defun insert-abbrevs ()
     101             :   "Insert after point a description of all defined abbrevs.
     102             : Mark is set after the inserted text."
     103             :   (interactive)
     104           0 :   (push-mark
     105           0 :    (save-excursion
     106           0 :      (dolist (tablesym abbrev-table-name-list)
     107           0 :        (insert-abbrev-table-description tablesym t))
     108           0 :      (point))))
     109             : 
     110             : (defun list-abbrevs (&optional local)
     111             :   "Display a list of defined abbrevs.
     112             : If LOCAL is non-nil, interactively when invoked with a
     113             : prefix arg, display only local, i.e. mode-specific, abbrevs.
     114             : Otherwise display all abbrevs."
     115             :   (interactive "P")
     116           0 :   (display-buffer (prepare-abbrev-list-buffer local)))
     117             : 
     118             : (defun abbrev-table-name (table)
     119             :   "Value is the name of abbrev table TABLE."
     120           0 :   (let ((tables abbrev-table-name-list)
     121             :         found)
     122           0 :     (while (and (not found) tables)
     123           0 :       (when (eq (symbol-value (car tables)) table)
     124           0 :         (setq found (car tables)))
     125           0 :       (setq tables (cdr tables)))
     126           0 :     found))
     127             : 
     128             : (defun prepare-abbrev-list-buffer (&optional local)
     129           0 :   (let ((local-table local-abbrev-table))
     130           0 :     (with-current-buffer (get-buffer-create "*Abbrevs*")
     131           0 :       (erase-buffer)
     132           0 :       (if local
     133           0 :           (insert-abbrev-table-description
     134           0 :            (abbrev-table-name local-table) t)
     135           0 :         (let (empty-tables)
     136           0 :           (dolist (table abbrev-table-name-list)
     137           0 :             (if (abbrev-table-empty-p (symbol-value table))
     138           0 :                 (push table empty-tables)
     139           0 :               (insert-abbrev-table-description table t)))
     140           0 :           (dolist (table (nreverse empty-tables))
     141           0 :             (insert-abbrev-table-description table t)))
     142             :         ;; Note: `list-abbrevs' can display only local abbrevs, in
     143             :         ;; which case editing could lose abbrevs of other tables. Thus
     144             :         ;; enter `edit-abbrevs-mode' only if LOCAL is nil.
     145           0 :         (edit-abbrevs-mode))
     146           0 :       (goto-char (point-min))
     147           0 :       (set-buffer-modified-p nil)
     148           0 :       (current-buffer))))
     149             : 
     150             : (defun edit-abbrevs ()
     151             :   "Alter abbrev definitions by editing a list of them.
     152             : Selects a buffer containing a list of abbrev definitions with
     153             : point located in the abbrev table of current buffer.
     154             : You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs
     155             : according to your editing.
     156             : Buffer contains a header line for each abbrev table,
     157             :  which is the abbrev table name in parentheses.
     158             : This is followed by one line per abbrev in that table:
     159             : NAME   USECOUNT   EXPANSION   HOOK
     160             : where NAME and EXPANSION are strings with quotes,
     161             : USECOUNT is an integer, and HOOK is any valid function
     162             : or may be omitted (it is usually omitted)."
     163             :   (interactive)
     164           0 :   (let ((table-name (abbrev-table-name local-abbrev-table)))
     165           0 :     (switch-to-buffer (prepare-abbrev-list-buffer))
     166           0 :     (when (and table-name
     167           0 :                (search-forward
     168           0 :                 (concat "(" (symbol-name table-name) ")\n\n") nil t))
     169           0 :       (goto-char (match-end 0)))))
     170             : 
     171             : (defun edit-abbrevs-redefine ()
     172             :   "Redefine abbrevs according to current buffer contents."
     173             :   (interactive)
     174           0 :   (save-restriction
     175           0 :     (widen)
     176           0 :     (define-abbrevs t)
     177           0 :     (set-buffer-modified-p nil)))
     178             : 
     179             : (defun define-abbrevs (&optional arg)
     180             :   "Define abbrevs according to current visible buffer contents.
     181             : See documentation of `edit-abbrevs' for info on the format of the
     182             : text you must have in the buffer.
     183             : With argument, eliminate all abbrev definitions except
     184             : the ones defined from the buffer now."
     185             :   (interactive "P")
     186           0 :   (if arg (kill-all-abbrevs))
     187           0 :   (save-excursion
     188           0 :     (goto-char (point-min))
     189           0 :     (while (and (not (eobp)) (re-search-forward "^(" nil t))
     190           0 :       (let* ((buf (current-buffer))
     191           0 :              (table (read buf))
     192             :              abbrevs name hook exp count sys)
     193           0 :         (forward-line 1)
     194           0 :         (while (progn (forward-line 1)
     195           0 :                       (not (eolp)))
     196           0 :           (setq name (read buf) count (read buf))
     197           0 :           (if (equal count '(sys))
     198           0 :               (setq sys t count (read buf))
     199           0 :             (setq sys nil))
     200           0 :           (setq exp (read buf))
     201           0 :           (skip-chars-backward " \t\n\f")
     202           0 :           (setq hook (if (not (eolp)) (read buf)))
     203           0 :           (skip-chars-backward " \t\n\f")
     204           0 :           (setq abbrevs (cons (list name exp hook count sys) abbrevs)))
     205           0 :         (define-abbrev-table table abbrevs)))))
     206             : 
     207             : (defun read-abbrev-file (&optional file quietly)
     208             :   "Read abbrev definitions from file written with `write-abbrev-file'.
     209             : Optional argument FILE is the name of the file to read;
     210             : it defaults to the value of `abbrev-file-name'.
     211             : Optional second argument QUIETLY non-nil means don't display a message."
     212             :   (interactive
     213           0 :    (list
     214           0 :     (read-file-name (format "Read abbrev file (default %s): "
     215           0 :                             abbrev-file-name)
     216           0 :                     nil abbrev-file-name t)))
     217           0 :   (load (or file abbrev-file-name) nil quietly)
     218           0 :   (setq abbrevs-changed nil))
     219             : 
     220             : (defun quietly-read-abbrev-file (&optional file)
     221             :   "Read abbrev definitions from file written with `write-abbrev-file'.
     222             : Optional argument FILE is the name of the file to read;
     223             : it defaults to the value of `abbrev-file-name'.
     224             : Does not display any message."
     225             :                                         ;(interactive "fRead abbrev file: ")
     226           0 :   (read-abbrev-file file t))
     227             : 
     228             : (defun write-abbrev-file (&optional file verbose)
     229             :   "Write all user-level abbrev definitions to a file of Lisp code.
     230             : This does not include system abbrevs; it includes only the abbrev tables
     231             : listed in listed in `abbrev-table-name-list'.
     232             : The file written can be loaded in another session to define the same abbrevs.
     233             : The argument FILE is the file name to write.  If omitted or nil, the file
     234             : specified in `abbrev-file-name' is used.
     235             : If VERBOSE is non-nil, display a message indicating where abbrevs
     236             : have been saved."
     237             :   (interactive
     238           0 :    (list
     239           0 :     (read-file-name "Write abbrev file: "
     240           0 :                     (file-name-directory (expand-file-name abbrev-file-name))
     241           0 :                     abbrev-file-name)))
     242           0 :   (or (and file (> (length file) 0))
     243           0 :       (setq file abbrev-file-name))
     244           0 :   (let ((coding-system-for-write 'utf-8))
     245           0 :     (with-temp-buffer
     246           0 :       (dolist (table
     247             :                ;; We sort the table in order to ease the automatic
     248             :                ;; merging of different versions of the user's abbrevs
     249             :                ;; file.  This is useful, for example, for when the
     250             :                ;; user keeps their home directory in a revision
     251             :                ;; control system, and is therefore keeping multiple
     252             :                ;; slightly-differing copies loosely synchronized.
     253           0 :                (sort (copy-sequence abbrev-table-name-list)
     254             :                      (lambda (s1 s2)
     255           0 :                        (string< (symbol-name s1)
     256           0 :                                 (symbol-name s2)))))
     257           0 :         (insert-abbrev-table-description table nil))
     258           0 :       (when (unencodable-char-position (point-min) (point-max) 'utf-8)
     259           0 :         (setq coding-system-for-write
     260           0 :               (if (> emacs-major-version 24)
     261             :                   'utf-8-emacs
     262             :                 ;; For compatibility with Emacs 22 (See Bug#8308)
     263           0 :                 'emacs-mule)))
     264           0 :       (goto-char (point-min))
     265           0 :       (insert (format ";;-*-coding: %s;-*-\n" coding-system-for-write))
     266           0 :       (write-region nil nil file nil (and (not verbose) 0)))))
     267             : 
     268             : (defun abbrev-edit-save-to-file (file)
     269             :   "Save all user-level abbrev definitions in current buffer to FILE."
     270             :   (interactive
     271           0 :    (list (read-file-name "Save abbrevs to file: "
     272           0 :                          (file-name-directory
     273           0 :                           (expand-file-name abbrev-file-name))
     274           0 :                          abbrev-file-name)))
     275           0 :   (edit-abbrevs-redefine)
     276           0 :   (write-abbrev-file file t))
     277             : 
     278             : (defun abbrev-edit-save-buffer ()
     279             :   "Save all user-level abbrev definitions in current buffer.
     280             : The saved abbrevs are written to the file specified by
     281             : `abbrev-file-name'."
     282             :   (interactive)
     283           0 :   (abbrev-edit-save-to-file abbrev-file-name))
     284             : 
     285             : 
     286             : (defun add-mode-abbrev (arg)
     287             :   "Define mode-specific abbrev for last word(s) before point.
     288             : Argument is how many words before point form the expansion;
     289             : or zero means the region is the expansion.
     290             : A negative argument means to undefine the specified abbrev.
     291             : Reads the abbreviation in the minibuffer.
     292             : 
     293             : Don't use this function in a Lisp program; use `define-abbrev' instead."
     294             :   (interactive "p")
     295           0 :   (add-abbrev
     296           0 :    (if only-global-abbrevs
     297           0 :        global-abbrev-table
     298           0 :      (or local-abbrev-table
     299           0 :          (error "No per-mode abbrev table")))
     300           0 :    "Mode" arg))
     301             : 
     302             : (defun add-global-abbrev (arg)
     303             :   "Define global (all modes) abbrev for last word(s) before point.
     304             : The prefix argument specifies the number of words before point that form the
     305             : expansion; or zero means the region is the expansion.
     306             : A negative argument means to undefine the specified abbrev.
     307             : This command uses the minibuffer to read the abbreviation.
     308             : 
     309             : Don't use this function in a Lisp program; use `define-abbrev' instead."
     310             :   (interactive "p")
     311           0 :   (add-abbrev global-abbrev-table "Global" arg))
     312             : 
     313             : (defun add-abbrev (table type arg)
     314           0 :   (let ((exp (and (>= arg 0)
     315           0 :                   (buffer-substring-no-properties
     316           0 :                    (point)
     317           0 :                    (if (= arg 0) (mark)
     318           0 :                      (save-excursion (forward-word (- arg)) (point))))))
     319             :         name)
     320           0 :     (setq name
     321           0 :           (read-string (format (if exp "%s abbrev for \"%s\": "
     322           0 :                                  "Undefine %s abbrev: ")
     323           0 :                                type exp)))
     324           0 :     (set-text-properties 0 (length name) nil name)
     325           0 :     (if (or (null exp)
     326           0 :             (not (abbrev-expansion name table))
     327           0 :             (y-or-n-p (format "%s expands to \"%s\"; redefine? "
     328           0 :                               name (abbrev-expansion name table))))
     329           0 :         (define-abbrev table (downcase name) exp))))
     330             : 
     331             : (defun inverse-add-mode-abbrev (n)
     332             :   "Define last word before point as a mode-specific abbrev.
     333             : With prefix argument N, defines the Nth word before point.
     334             : This command uses the minibuffer to read the expansion.
     335             : Expands the abbreviation after defining it."
     336             :   (interactive "p")
     337           0 :   (inverse-add-abbrev
     338           0 :    (if only-global-abbrevs
     339           0 :        global-abbrev-table
     340           0 :      (or local-abbrev-table
     341           0 :          (error "No per-mode abbrev table")))
     342           0 :    "Mode" n))
     343             : 
     344             : (defun inverse-add-global-abbrev (n)
     345             :   "Define last word before point as a global (mode-independent) abbrev.
     346             : With prefix argument N, defines the Nth word before point.
     347             : This command uses the minibuffer to read the expansion.
     348             : Expands the abbreviation after defining it."
     349             :   (interactive "p")
     350           0 :   (inverse-add-abbrev global-abbrev-table "Global" n))
     351             : 
     352             : (defun inverse-add-abbrev (table type arg)
     353           0 :   (let (name exp start end)
     354           0 :     (save-excursion
     355           0 :       (forward-word (1+ (- arg)))
     356           0 :       (setq end (point))
     357           0 :       (backward-word 1)
     358           0 :       (setq start (point)
     359           0 :             name (buffer-substring-no-properties start end)))
     360             : 
     361           0 :     (setq exp (read-string (format "%s expansion for \"%s\": " type name)
     362           0 :                            nil nil nil t))
     363           0 :     (when (or (not (abbrev-expansion name table))
     364           0 :               (y-or-n-p (format "%s expands to \"%s\"; redefine? "
     365           0 :                                 name (abbrev-expansion name table))))
     366           0 :       (define-abbrev table (downcase name) exp)
     367           0 :       (save-excursion
     368           0 :         (goto-char end)
     369           0 :         (expand-abbrev)))))
     370             : 
     371             : (defun abbrev-prefix-mark (&optional arg)
     372             :   "Mark current point as the beginning of an abbrev.
     373             : Abbrev to be expanded starts here rather than at beginning of word.
     374             : This way, you can expand an abbrev with a prefix: insert the prefix,
     375             : use this command, then insert the abbrev.  This command inserts a
     376             : temporary hyphen after the prefix (until the intended abbrev
     377             : expansion occurs).
     378             : If the prefix is itself an abbrev, this command expands it, unless
     379             : ARG is non-nil.  Interactively, ARG is the prefix argument."
     380             :   (interactive "P")
     381           0 :   (or arg (expand-abbrev))
     382           0 :   (setq abbrev-start-location (point-marker)
     383           0 :         abbrev-start-location-buffer (current-buffer))
     384           0 :   (insert "-"))
     385             : 
     386             : (defun expand-region-abbrevs (start end &optional noquery)
     387             :   "For abbrev occurrence in the region, offer to expand it.
     388             : The user is asked to type `y' or `n' for each occurrence.
     389             : A prefix argument means don't query; expand all abbrevs."
     390             :   (interactive "r\nP")
     391           0 :   (save-excursion
     392           0 :     (goto-char start)
     393           0 :     (let ((lim (- (point-max) end))
     394             :           pnt string)
     395           0 :       (while (and (not (eobp))
     396           0 :                   (progn (forward-word 1)
     397           0 :                          (<= (setq pnt (point)) (- (point-max) lim))))
     398           0 :         (if (abbrev-expansion
     399           0 :              (setq string
     400           0 :                    (buffer-substring-no-properties
     401           0 :                     (save-excursion (forward-word -1) (point))
     402           0 :                     pnt)))
     403           0 :             (if (or noquery (y-or-n-p (format-message "Expand `%s'? " string)))
     404           0 :                 (expand-abbrev)))))))
     405             : 
     406             : ;;; Abbrev properties.
     407             : 
     408             : (defun abbrev-table-get (table prop)
     409             :   "Get the PROP property of abbrev table TABLE."
     410         150 :   (let ((sym (obarray-get table "")))
     411         150 :     (if sym (get sym prop))))
     412             : 
     413             : (defun abbrev-table-put (table prop val)
     414             :   "Set the PROP property of abbrev table TABLE to VAL."
     415           8 :   (let ((sym (obarray-put table "")))
     416           8 :     (set sym nil)            ; Make sure it won't be confused for an abbrev.
     417           8 :     (put sym prop val)))
     418             : 
     419             : (defalias 'abbrev-get 'get
     420             :   "Get the property PROP of abbrev ABBREV
     421             : 
     422             : \(fn ABBREV PROP)")
     423             : 
     424             : (defalias 'abbrev-put 'put
     425             :   "Set the property PROP of abbrev ABBREV to value VAL.
     426             : See `define-abbrev' for the effect of some special properties.
     427             : 
     428             : \(fn ABBREV PROP VAL)")
     429             : 
     430             : ;;; Code that used to be implemented in src/abbrev.c
     431             : 
     432             : (defvar abbrev-table-name-list '(fundamental-mode-abbrev-table
     433             :                                  global-abbrev-table)
     434             :   "List of symbols whose values are abbrev tables.")
     435             : 
     436             : (defun make-abbrev-table (&optional props)
     437             :   "Create a new, empty abbrev table object.
     438             : PROPS is a list of properties."
     439           7 :   (let ((table (obarray-make)))
     440             :     ;; Each abbrev-table has a `modiff' counter which can be used to detect
     441             :     ;; when an abbreviation was added.  An example of use would be to
     442             :     ;; construct :regexp dynamically as the union of all abbrev names, so
     443             :     ;; `modiff' can let us detect that an abbrev was added and hence :regexp
     444             :     ;; needs to be refreshed.
     445             :     ;; The presence of `modiff' entry is also used as a tag indicating this
     446             :     ;; vector is really an abbrev-table.
     447           7 :     (abbrev-table-put table :abbrev-table-modiff 0)
     448           7 :     (while (consp props)
     449           7 :       (abbrev-table-put table (pop props) (pop props)))
     450           7 :     table))
     451             : 
     452             : (defun abbrev-table-p (object)
     453             :   "Return non-nil if OBJECT is an abbrev table."
     454           0 :   (and (obarrayp object)
     455           0 :        (numberp (abbrev-table-get object :abbrev-table-modiff))))
     456             : 
     457             : (defun abbrev-table-empty-p (object &optional ignore-system)
     458             :   "Return nil if there are no abbrev symbols in OBJECT.
     459             : If IGNORE-SYSTEM is non-nil, system definitions are ignored."
     460           0 :   (unless (abbrev-table-p object)
     461           0 :     (error "Non abbrev table object"))
     462           0 :   (not (catch 'some
     463           0 :          (obarray-map (lambda (abbrev)
     464           0 :                         (unless (or (zerop (length (symbol-name abbrev)))
     465           0 :                                     (and ignore-system
     466           0 :                                          (abbrev-get abbrev :system)))
     467           0 :                           (throw 'some t)))
     468           0 :                       object))))
     469             : 
     470             : (defvar global-abbrev-table (make-abbrev-table)
     471             :   "The abbrev table whose abbrevs affect all buffers.
     472             : Each buffer may also have a local abbrev table.
     473             : If it does, the local table overrides the global one
     474             : for any particular abbrev defined in both.")
     475             : 
     476             : (defvar abbrev-minor-mode-table-alist nil
     477             :   "Alist of abbrev tables to use for minor modes.
     478             : Each element looks like (VARIABLE . ABBREV-TABLE);
     479             : ABBREV-TABLE is active whenever VARIABLE's value is non-nil.
     480             : ABBREV-TABLE can also be a list of abbrev tables.")
     481             : 
     482             : (defvar fundamental-mode-abbrev-table
     483             :   (let ((table (make-abbrev-table)))
     484             :     ;; Set local-abbrev-table's default to be fundamental-mode-abbrev-table.
     485             :     (setq-default local-abbrev-table table)
     486             :     table)
     487             :   "The abbrev table of mode-specific abbrevs for Fundamental Mode.")
     488             : 
     489             : (defvar abbrevs-changed nil
     490             :   "Set non-nil by defining or altering any word abbrevs.
     491             : This causes `save-some-buffers' to offer to save the abbrevs.")
     492             : 
     493             : (defcustom abbrev-all-caps nil
     494             :   "Non-nil means expand multi-word abbrevs all caps if abbrev was so."
     495             :   :type 'boolean
     496             :   :group 'abbrev-mode)
     497             : 
     498             : (defvar abbrev-start-location nil
     499             :   "Buffer position for `expand-abbrev' to use as the start of the abbrev.
     500             : When nil, use the word before point as the abbrev.
     501             : Calling `expand-abbrev' sets this to nil.")
     502             : 
     503             : (defvar abbrev-start-location-buffer nil
     504             :   "Buffer that `abbrev-start-location' has been set for.
     505             : Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.")
     506             : 
     507             : (defvar last-abbrev nil
     508             :   "The abbrev-symbol of the last abbrev expanded.  See `abbrev-symbol'.")
     509             : 
     510             : (defvar last-abbrev-text nil
     511             :   "The exact text of the last abbrev expanded.
     512             : It is nil if the abbrev has already been unexpanded.")
     513             : 
     514             : (defvar last-abbrev-location 0
     515             :   "The location of the start of the last abbrev expanded.")
     516             : 
     517             : ;; (defvar local-abbrev-table fundamental-mode-abbrev-table
     518             : ;;   "Local (mode-specific) abbrev table of current buffer.")
     519             : ;; (make-variable-buffer-local 'local-abbrev-table)
     520             : 
     521             : (defcustom pre-abbrev-expand-hook nil
     522             :   "Function or functions to be called before abbrev expansion is done.
     523             : This is the first thing that `expand-abbrev' does, and so this may change
     524             : the current abbrev table before abbrev lookup happens."
     525             :   :type 'hook
     526             :   :group 'abbrev-mode)
     527             : (make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-function "23.1")
     528             : 
     529             : (defun clear-abbrev-table (table)
     530             :   "Undefine all abbrevs in abbrev table TABLE, leaving it empty."
     531           0 :   (setq abbrevs-changed t)
     532           0 :   (let* ((sym (obarray-get table "")))
     533           0 :     (dotimes (i (length table))
     534           0 :       (aset table i 0))
     535             :     ;; Preserve the table's properties.
     536           0 :     (cl-assert sym)
     537           0 :     (let ((newsym (obarray-put table "")))
     538           0 :       (set newsym nil)       ; Make sure it won't be confused for an abbrev.
     539           0 :       (setplist newsym (symbol-plist sym)))
     540           0 :     (abbrev-table-put table :abbrev-table-modiff
     541           0 :                       (1+ (abbrev-table-get table :abbrev-table-modiff))))
     542             :   ;; For backward compatibility, always return nil.
     543             :   nil)
     544             : 
     545             : (defun define-abbrev (table name expansion &optional hook &rest props)
     546             :   "Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.
     547             : NAME must be a string, and should be lower-case.
     548             : EXPANSION should usually be a string.
     549             : To undefine an abbrev, define it with EXPANSION = nil.
     550             : If HOOK is non-nil, it should be a function of no arguments;
     551             : it is called after EXPANSION is inserted.
     552             : If EXPANSION is not a string (and not nil), the abbrev is a
     553             :  special one, which does not expand in the usual way but only
     554             :  runs HOOK.
     555             : 
     556             : If HOOK is a non-nil symbol with a non-nil `no-self-insert' property,
     557             : it can control whether the character that triggered abbrev expansion
     558             : is inserted.  If such a HOOK returns non-nil, the character is not
     559             : inserted.  If such a HOOK returns nil, then so does `abbrev-insert'
     560             : \(and `expand-abbrev'), as if no abbrev expansion had taken place.
     561             : 
     562             : PROPS is a property list.  The following properties are special:
     563             : - `:count': the value for the abbrev's usage-count, which is incremented each
     564             :   time the abbrev is used (the default is zero).
     565             : - `:system': if non-nil, says that this is a \"system\" abbreviation
     566             :   which should not be saved in the user's abbreviation file.
     567             :   Unless `:system' is `force', a system abbreviation will not
     568             :   overwrite a non-system abbreviation of the same name.
     569             : - `:case-fixed': non-nil means that abbreviations are looked up without
     570             :   case-folding, and the expansion is not capitalized/upcased.
     571             : - `:enable-function': a function of no argument which returns non-nil if the
     572             :   abbrev should be used for a particular call of `expand-abbrev'.
     573             : 
     574             : An obsolete but still supported calling form is:
     575             : 
     576             : \(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)."
     577           0 :   (when (and (consp props) (or (null (car props)) (numberp (car props))))
     578             :     ;; Old-style calling convention.
     579           0 :     (setq props `(:count ,(car props)
     580           0 :                   ,@(if (cadr props) (list :system (cadr props))))))
     581           0 :   (unless (plist-get props :count)
     582           0 :     (setq props (plist-put props :count 0)))
     583           0 :   (setq props (plist-put props :abbrev-table-modiff
     584           0 :                          (abbrev-table-get table :abbrev-table-modiff)))
     585           0 :   (let ((system-flag (plist-get props :system))
     586           0 :         (sym (obarray-put table name)))
     587             :     ;; Don't override a prior user-defined abbrev with a system abbrev,
     588             :     ;; unless system-flag is `force'.
     589           0 :     (unless (and (not (memq system-flag '(nil force)))
     590           0 :                  (boundp sym) (symbol-value sym)
     591           0 :                  (not (abbrev-get sym :system)))
     592           0 :       (unless (or system-flag
     593           0 :                   (and (boundp sym)
     594             :                        ;; load-file-name
     595           0 :                        (equal (symbol-value sym) expansion)
     596           0 :                        (equal (symbol-function sym) hook)))
     597           0 :         (setq abbrevs-changed t))
     598           0 :       (set sym expansion)
     599           0 :       (fset sym hook)
     600           0 :       (setplist sym
     601             :                 ;; Don't store the `force' value of `system-flag' into
     602             :                 ;; the :system property.
     603           0 :                 (if (eq 'force system-flag) (plist-put props :system t) props))
     604           0 :       (abbrev-table-put table :abbrev-table-modiff
     605           0 :                         (1+ (abbrev-table-get table :abbrev-table-modiff))))
     606           0 :     name))
     607             : 
     608             : (defun abbrev--check-chars (abbrev global)
     609             :   "Check if the characters in ABBREV have word syntax in either the
     610             : current (if global is nil) or standard syntax table."
     611           0 :   (with-syntax-table
     612           0 :       (cond ((null global) (syntax-table))
     613             :             ;; ((syntax-table-p global) global)
     614           0 :             (t (standard-syntax-table)))
     615           0 :     (when (string-match "\\W" abbrev)
     616           0 :       (let ((badchars ())
     617             :             (pos 0))
     618           0 :         (while (string-match "\\W" abbrev pos)
     619           0 :           (cl-pushnew (aref abbrev (match-beginning 0)) badchars)
     620           0 :           (setq pos (1+ pos)))
     621           0 :         (error "Some abbrev characters (%s) are not word constituents %s"
     622           0 :                (apply 'string (nreverse badchars))
     623           0 :                (if global "in the standard syntax" "in this mode"))))))
     624             : 
     625             : (defun define-global-abbrev (abbrev expansion)
     626             :   "Define ABBREV as a global abbreviation for EXPANSION.
     627             : The characters in ABBREV must all be word constituents in the standard
     628             : syntax table."
     629             :   (interactive "sDefine global abbrev: \nsExpansion for %s: ")
     630           0 :   (abbrev--check-chars abbrev 'global)
     631           0 :   (define-abbrev global-abbrev-table (downcase abbrev) expansion))
     632             : 
     633             : (defun define-mode-abbrev (abbrev expansion)
     634             :   "Define ABBREV as a mode-specific abbreviation for EXPANSION.
     635             : The characters in ABBREV must all be word-constituents in the current mode."
     636             :   (interactive "sDefine mode abbrev: \nsExpansion for %s: ")
     637           0 :   (unless local-abbrev-table
     638           0 :     (error "Major mode has no abbrev table"))
     639           0 :   (abbrev--check-chars abbrev nil)
     640           0 :   (define-abbrev local-abbrev-table (downcase abbrev) expansion))
     641             : 
     642             : (defun abbrev--active-tables (&optional tables)
     643             :   "Return the list of abbrev tables currently active.
     644             : TABLES if non-nil overrides the usual rules.  It can hold
     645             : either a single abbrev table or a list of abbrev tables."
     646             :   ;; We could just remove the `tables' arg and let callers use
     647             :   ;; (or table (abbrev--active-tables)) but then they'd have to be careful
     648             :   ;; to treat the distinction between a single table and a list of tables.
     649           0 :   (cond
     650           0 :    ((consp tables) tables)
     651           0 :    ((vectorp tables) (list tables))
     652             :    (t
     653           0 :     (let ((tables (if (listp local-abbrev-table)
     654           0 :                       (append local-abbrev-table
     655           0 :                               (list global-abbrev-table))
     656           0 :                     (list local-abbrev-table global-abbrev-table))))
     657             :       ;; Add the minor-mode abbrev tables.
     658           0 :       (dolist (x abbrev-minor-mode-table-alist)
     659           0 :         (when (and (symbolp (car x)) (boundp (car x)) (symbol-value (car x)))
     660           0 :           (setq tables
     661           0 :                 (if (listp (cdr x))
     662           0 :                     (append (cdr x) tables) (cons (cdr x) tables)))))
     663           0 :       tables))))
     664             : 
     665             : 
     666             : (defun abbrev--symbol (abbrev table)
     667             :   "Return the symbol representing abbrev named ABBREV in TABLE.
     668             : This symbol's name is ABBREV, but it is not the canonical symbol of that name;
     669             : it is interned in the abbrev-table TABLE rather than the normal obarray.
     670             : The value is nil if that abbrev is not defined."
     671           0 :   (let* ((case-fold (not (abbrev-table-get table :case-fixed)))
     672             :          ;; In case the table doesn't set :case-fixed but some of the
     673             :          ;; abbrevs do, we have to be careful.
     674             :          (sym
     675             :           ;; First try without case-folding.
     676           0 :           (or (obarray-get table abbrev)
     677           0 :               (when case-fold
     678             :                 ;; We didn't find any abbrev, try case-folding.
     679           0 :                 (let ((sym (obarray-get table (downcase abbrev))))
     680             :                   ;; Only use it if it doesn't require :case-fixed.
     681           0 :                   (and sym (not (abbrev-get sym :case-fixed))
     682           0 :                        sym))))))
     683           0 :     (if (symbol-value sym)
     684           0 :         sym)))
     685             : 
     686             : (defun abbrev-symbol (abbrev &optional table)
     687             :   "Return the symbol representing abbrev named ABBREV.
     688             : This symbol's name is ABBREV, but it is not the canonical symbol of that name;
     689             : it is interned in an abbrev-table rather than the normal obarray.
     690             : The value is nil if that abbrev is not defined.
     691             : Optional second arg TABLE is abbrev table to look it up in.
     692             : The default is to try buffer's mode-specific abbrev table, then global table."
     693           0 :   (let ((tables (abbrev--active-tables table))
     694             :         sym)
     695           0 :     (while (and tables (not sym))
     696           0 :       (let* ((table (pop tables)))
     697           0 :         (setq tables (append (abbrev-table-get table :parents) tables))
     698           0 :         (setq sym (abbrev--symbol abbrev table))))
     699           0 :     sym))
     700             : 
     701             : 
     702             : (defun abbrev-expansion (abbrev &optional table)
     703             :   "Return the string that ABBREV expands into in the current buffer.
     704             : Optionally specify an abbrev table as second arg;
     705             : then ABBREV is looked up in that table only."
     706           0 :   (symbol-value (abbrev-symbol abbrev table)))
     707             : 
     708             : 
     709             : (defun abbrev--before-point ()
     710             :   "Try and find an abbrev before point.  Return it if found, nil otherwise."
     711           0 :   (unless (eq abbrev-start-location-buffer (current-buffer))
     712           0 :     (setq abbrev-start-location nil))
     713             : 
     714           0 :   (let ((tables (abbrev--active-tables))
     715           0 :         (pos (point))
     716             :         start end name res)
     717             : 
     718           0 :     (if abbrev-start-location
     719           0 :         (progn
     720           0 :           (setq start abbrev-start-location)
     721           0 :           (setq abbrev-start-location nil)
     722             :           ;; Remove the hyphen inserted by `abbrev-prefix-mark'.
     723           0 :           (when (and (< start (point-max))
     724           0 :                      (eq (char-after start) ?-))
     725           0 :             (delete-region start (1+ start))
     726           0 :             (setq pos (1- pos)))
     727           0 :           (skip-syntax-backward " ")
     728           0 :           (setq end (point))
     729           0 :           (when (> end start)
     730           0 :             (setq name (buffer-substring start end))
     731           0 :             (goto-char pos)               ; Restore point.
     732           0 :             (list (abbrev-symbol name tables) name start end)))
     733             : 
     734           0 :       (while (and tables (not (car res)))
     735           0 :         (let* ((table (pop tables))
     736           0 :                (enable-fun (abbrev-table-get table :enable-function)))
     737           0 :           (setq tables (append (abbrev-table-get table :parents) tables))
     738           0 :           (setq res
     739           0 :                 (and (or (not enable-fun) (funcall enable-fun))
     740           0 :                      (let ((re (abbrev-table-get table :regexp)))
     741           0 :                        (if (null re)
     742             :                            ;; We used to default `re' to "\\<\\(\\w+\\)\\W*"
     743             :                            ;; but when words-include-escapes is set, that
     744             :                            ;; is not right and fixing it is boring.
     745           0 :                            (let ((lim (point)))
     746           0 :                              (backward-word 1)
     747           0 :                              (setq start (point))
     748           0 :                              (forward-word 1)
     749           0 :                              (setq end (min (point) lim)))
     750           0 :                          (when (looking-back re (line-beginning-position))
     751           0 :                            (setq start (match-beginning 1))
     752           0 :                            (setq end   (match-end 1)))))
     753           0 :                      (setq name  (buffer-substring start end))
     754           0 :                      (let ((abbrev (abbrev--symbol name table)))
     755           0 :                        (when abbrev
     756           0 :                          (setq enable-fun (abbrev-get abbrev :enable-function))
     757           0 :                          (and (or (not enable-fun) (funcall enable-fun))
     758             :                               ;; This will also look it up in parent tables.
     759             :                               ;; This is not on purpose, but it seems harmless.
     760           0 :                               (list abbrev name start end))))))
     761             :           ;; Restore point.
     762           0 :           (goto-char pos)))
     763           0 :       res)))
     764             : 
     765             : (defun abbrev-insert (abbrev &optional name wordstart wordend)
     766             :   "Insert abbrev ABBREV at point.
     767             : If non-nil, NAME is the name by which this abbrev was found.
     768             : If non-nil, WORDSTART is the place where to insert the abbrev.
     769             : If WORDEND is non-nil, the abbrev replaces the previous text between
     770             : WORDSTART and WORDEND.
     771             : Return ABBREV if the expansion should be considered as having taken place.
     772             : The return value can be influenced by a `no-self-insert' property;
     773             : see `define-abbrev' for details."
     774           0 :   (unless name (setq name (symbol-name abbrev)))
     775           0 :   (unless wordstart (setq wordstart (point)))
     776           0 :   (unless wordend (setq wordend wordstart))
     777             :   ;; Increment use count.
     778           0 :   (abbrev-put abbrev :count (1+ (abbrev-get abbrev :count)))
     779           0 :   (let ((value abbrev))
     780             :     ;; If this abbrev has an expansion, delete the abbrev
     781             :     ;; and insert the expansion.
     782           0 :     (when (stringp (symbol-value abbrev))
     783           0 :       (goto-char wordstart)
     784             :       ;; Insert at beginning so that markers at the end (e.g. point)
     785             :       ;; are preserved.
     786           0 :       (insert (symbol-value abbrev))
     787           0 :       (delete-char (- wordend wordstart))
     788           0 :       (let ((case-fold-search nil))
     789             :         ;; If the abbrev's name is different from the buffer text (the
     790             :         ;; only difference should be capitalization), then we may want
     791             :         ;; to adjust the capitalization of the expansion.
     792           0 :         (when (and (not (equal name (symbol-name abbrev)))
     793           0 :                    (string-match "[[:upper:]]" name))
     794           0 :           (if (not (string-match "[[:lower:]]" name))
     795             :               ;; Abbrev was all caps.  If expansion is multiple words,
     796             :               ;; normally capitalize each word.
     797           0 :               (if (and (not abbrev-all-caps)
     798           0 :                        (save-excursion
     799           0 :                          (> (progn (backward-word 1) (point))
     800           0 :                             (progn (goto-char wordstart)
     801           0 :                                    (forward-word 1) (point)))))
     802           0 :                   (upcase-initials-region wordstart (point))
     803           0 :                 (upcase-region wordstart (point)))
     804             :             ;; Abbrev included some caps.  Cap first initial of expansion.
     805           0 :             (let ((end (point)))
     806             :               ;; Find the initial.
     807           0 :               (goto-char wordstart)
     808           0 :               (skip-syntax-forward "^w" (1- end))
     809             :               ;; Change just that.
     810           0 :               (upcase-initials-region (point) (1+ (point)))
     811           0 :               (goto-char end))))))
     812             :     ;; Now point is at the end of the expansion and the beginning is
     813             :     ;; in last-abbrev-location.
     814           0 :     (when (symbol-function abbrev)
     815           0 :       (let* ((hook (symbol-function abbrev))
     816             :              (expanded
     817             :               ;; If the abbrev has a hook function, run it.
     818           0 :               (funcall hook)))
     819             :         ;; In addition, if the hook function is a symbol with
     820             :         ;; a non-nil `no-self-insert' property, let the value it
     821             :         ;; returned specify whether we consider that an expansion took
     822             :         ;; place.  If it returns nil, no expansion has been done.
     823           0 :         (if (and (symbolp hook)
     824           0 :                  (null expanded)
     825           0 :                  (get hook 'no-self-insert))
     826           0 :             (setq value nil))))
     827           0 :     value))
     828             : 
     829             : (defvar abbrev-expand-functions nil
     830             :   "Wrapper hook around `abbrev--default-expand'.")
     831             : (make-obsolete-variable 'abbrev-expand-functions 'abbrev-expand-function "24.4")
     832             : 
     833             : (defvar abbrev-expand-function #'abbrev--default-expand
     834             :   "Function that `expand-abbrev' uses to perform abbrev expansion.
     835             : Takes no argument and should return the abbrev symbol if expansion took place.")
     836             : 
     837             : (defun expand-abbrev ()
     838             :   "Expand the abbrev before point, if there is an abbrev there.
     839             : Effective when explicitly called even when `abbrev-mode' is nil.
     840             : Before doing anything else, runs `pre-abbrev-expand-hook'.
     841             : Calls the value of `abbrev-expand-function' with no argument to do
     842             : the work, and returns whatever it does.  (That return value should
     843             : be the abbrev symbol if expansion occurred, else nil.)"
     844             :   (interactive)
     845           0 :   (run-hooks 'pre-abbrev-expand-hook)
     846           0 :   (funcall abbrev-expand-function))
     847             : 
     848             : (defun abbrev--default-expand ()
     849             :   "Default function to use for `abbrev-expand-function'.
     850             : This also respects the obsolete wrapper hook `abbrev-expand-functions'.
     851             : \(See `with-wrapper-hook' for details about wrapper hooks.)
     852             : Calls `abbrev-insert' to insert any expansion, and returns what it does."
     853           0 :   (subr--with-wrapper-hook-no-warnings abbrev-expand-functions ()
     854             :     (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point)))
     855             :       (when sym
     856             :         (let ((startpos (copy-marker (point) t))
     857             :               (endmark (copy-marker wordend t)))
     858             :           (unless (or ;; executing-kbd-macro
     859             :                    noninteractive
     860             :                    (window-minibuffer-p))
     861             :             ;; Add an undo boundary, in case we are doing this for
     862             :             ;; a self-inserting command which has avoided making one so far.
     863             :             (undo-boundary))
     864             :           ;; Now sym is the abbrev symbol.
     865             :           (setq last-abbrev-text name)
     866             :           (setq last-abbrev sym)
     867             :           (setq last-abbrev-location wordstart)
     868             :           ;; If this abbrev has an expansion, delete the abbrev
     869             :           ;; and insert the expansion.
     870             :           (prog1
     871             :               (abbrev-insert sym name wordstart wordend)
     872             :             ;; Yuck!!  If expand-abbrev is called with point slightly
     873             :             ;; further than the end of the abbrev, move point back to
     874             :             ;; where it started.
     875             :             (if (and (> startpos endmark)
     876             :                      (= (point) endmark)) ;Obey skeletons that move point.
     877           0 :                 (goto-char startpos))))))))
     878             : 
     879             : (defun unexpand-abbrev ()
     880             :   "Undo the expansion of the last abbrev that expanded.
     881             : This differs from ordinary undo in that other editing done since then
     882             : is not undone."
     883             :   (interactive)
     884           0 :   (save-excursion
     885           0 :     (unless (or (< last-abbrev-location (point-min))
     886           0 :                 (> last-abbrev-location (point-max)))
     887           0 :       (goto-char last-abbrev-location)
     888           0 :       (when (stringp last-abbrev-text)
     889             :         ;; This isn't correct if last-abbrev's hook was used
     890             :         ;; to do the expansion.
     891           0 :         (let ((val (symbol-value last-abbrev)))
     892           0 :           (unless (stringp val)
     893           0 :             (error "Value of abbrev-symbol must be a string"))
     894             :           ;; Don't inherit properties here; just copy from old contents.
     895           0 :           (insert last-abbrev-text)
     896             :           ;; Delete after inserting, to better preserve markers.
     897           0 :           (delete-region (point) (+ (point) (length val)))
     898           0 :           (setq last-abbrev-text nil))))))
     899             : 
     900             : (defun abbrev--write (sym)
     901             :   "Write the abbrev in a `read'able form.
     902             : Only writes the non-system abbrevs.
     903             : Presumes that `standard-output' points to `current-buffer'."
     904           0 :   (unless (or (null (symbol-value sym)) (abbrev-get sym :system))
     905           0 :     (insert "    (")
     906           0 :     (prin1 (symbol-name sym))
     907           0 :     (insert " ")
     908           0 :     (prin1 (symbol-value sym))
     909           0 :     (insert " ")
     910           0 :     (prin1 (symbol-function sym))
     911           0 :     (insert " ")
     912           0 :     (prin1 (abbrev-get sym :count))
     913           0 :     (insert ")\n")))
     914             : 
     915             : (defun abbrev--describe (sym)
     916           0 :   (when (symbol-value sym)
     917           0 :     (prin1 (symbol-name sym))
     918           0 :     (if (null (abbrev-get sym :system))
     919           0 :         (indent-to 15 1)
     920           0 :       (insert " (sys)")
     921           0 :       (indent-to 20 1))
     922           0 :     (prin1 (abbrev-get sym :count))
     923           0 :     (indent-to 20 1)
     924           0 :     (prin1 (symbol-value sym))
     925           0 :     (when (symbol-function sym)
     926           0 :       (indent-to 45 1)
     927           0 :       (prin1 (symbol-function sym)))
     928           0 :     (terpri)))
     929             : 
     930             : (defun insert-abbrev-table-description (name &optional readable)
     931             :   "Insert before point a full description of abbrev table named NAME.
     932             : NAME is a symbol whose value is an abbrev table.
     933             : If optional 2nd arg READABLE is non-nil, a human-readable description
     934             : is inserted.  Otherwise the description is an expression,
     935             : a call to `define-abbrev-table', which would
     936             : define the abbrev table NAME exactly as it is currently defined.
     937             : 
     938             : Abbrevs marked as \"system abbrevs\" are omitted."
     939           0 :   (let ((table (symbol-value name))
     940             :         (symbols ()))
     941           0 :     (mapatoms (lambda (sym) (if (symbol-value sym) (push sym symbols))) table)
     942           0 :     (setq symbols (sort symbols 'string-lessp))
     943           0 :     (let ((standard-output (current-buffer)))
     944           0 :       (if readable
     945           0 :           (progn
     946           0 :             (insert "(")
     947           0 :             (prin1 name)
     948           0 :             (insert ")\n\n")
     949           0 :             (mapc 'abbrev--describe symbols)
     950           0 :             (insert "\n\n"))
     951           0 :         (insert "(define-abbrev-table '")
     952           0 :         (prin1 name)
     953           0 :         (if (null symbols)
     954           0 :             (insert " '())\n\n")
     955           0 :           (insert "\n  '(\n")
     956           0 :           (mapc 'abbrev--write symbols)
     957           0 :           (insert "   ))\n\n")))
     958           0 :       nil)))
     959             : 
     960             : (defun define-abbrev-table (tablename definitions
     961             :                                       &optional docstring &rest props)
     962             :   "Define TABLENAME (a symbol) as an abbrev table name.
     963             : Define abbrevs in it according to DEFINITIONS, which is a list of elements
     964             : of the form (ABBREVNAME EXPANSION ...) that are passed to `define-abbrev'.
     965             : PROPS is a property list to apply to the table.
     966             : Properties with special meaning:
     967             : - `:parents' contains a list of abbrev tables from which this table inherits
     968             :   abbreviations.
     969             : - `:case-fixed' non-nil means that abbreviations are looked up without
     970             :   case-folding, and the expansion is not capitalized/upcased.
     971             : - `:regexp' is a regular expression that specifies how to extract the
     972             :   name of the abbrev before point.  The submatch 1 is treated
     973             :   as the potential name of an abbrev.  If :regexp is nil, the default
     974             :   behavior uses `backward-word' and `forward-word' to extract the name
     975             :   of the abbrev, which can therefore only be a single word.
     976             : - `:enable-function' can be set to a function of no argument which returns
     977             :   non-nil if and only if the abbrevs in this table should be used for this
     978             :   instance of `expand-abbrev'."
     979             :   (declare (doc-string 3))
     980             :   ;; We used to manually add the docstring, but we also want to record this
     981             :   ;; location as the definition of the variable (in load-history), so we may
     982             :   ;; as well just use `defvar'.
     983           7 :   (when (and docstring props (symbolp docstring))
     984             :     ;; There is really no docstring, instead the docstring arg
     985             :     ;; is a property name.
     986           7 :     (push docstring props) (setq docstring nil))
     987           7 :   (eval `(defvar ,tablename nil ,@(if docstring (list docstring))))
     988           7 :   (let ((table (if (boundp tablename) (symbol-value tablename))))
     989           7 :     (unless table
     990           7 :       (setq table (make-abbrev-table))
     991           7 :       (set tablename table)
     992           7 :       (unless (memq tablename abbrev-table-name-list)
     993          14 :         (push tablename abbrev-table-name-list)))
     994             :     ;; We used to just pass them to `make-abbrev-table', but that fails
     995             :     ;; if the table was pre-existing as is the case if it was created by
     996             :     ;; loading the user's abbrev file.
     997           7 :     (while (consp props)
     998           0 :       (unless (cdr props) (error "Missing value for property %S" (car props)))
     999           7 :       (abbrev-table-put table (pop props) (pop props)))
    1000           7 :     (dolist (elt definitions)
    1001           7 :       (apply 'define-abbrev table elt))))
    1002             : 
    1003             : (defun abbrev-table-menu (table &optional prompt sortfun)
    1004             :   "Return a menu that shows all abbrevs in TABLE.
    1005             : Selecting an entry runs `abbrev-insert'.
    1006             : PROMPT is the prompt to use for the keymap.
    1007             : SORTFUN is passed to `sort' to change the default ordering."
    1008           0 :   (unless sortfun (setq sortfun 'string-lessp))
    1009           0 :   (let ((entries ()))
    1010           0 :     (obarray-map (lambda (abbrev)
    1011           0 :                    (when (symbol-value abbrev)
    1012           0 :                      (let ((name (symbol-name abbrev)))
    1013           0 :                        (push `(,(intern name) menu-item ,name
    1014             :                                (lambda () (interactive)
    1015           0 :                                  (abbrev-insert ',abbrev)))
    1016           0 :                              entries))))
    1017           0 :                  table)
    1018           0 :     (nconc (make-sparse-keymap prompt)
    1019           0 :            (sort entries (lambda (x y)
    1020           0 :                            (funcall sortfun (nth 2 x) (nth 2 y)))))))
    1021             : 
    1022             : ;; Keep it after define-abbrev-table, since define-derived-mode uses
    1023             : ;; define-abbrev-table.
    1024             : (define-derived-mode edit-abbrevs-mode fundamental-mode "Edit-Abbrevs"
    1025             :   "Major mode for editing the list of abbrev definitions.")
    1026             : 
    1027             : (provide 'abbrev)
    1028             : 
    1029             : ;;; abbrev.el ends here

Generated by: LCOV version 1.12