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