| 1 | ;;; abbrev.el --- abbrev mode commands for Emacs |
| 2 | |
| 3 | ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Maintainer: FSF |
| 6 | ;; Keywords: abbrev convenience |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 13 | ;; any later version. |
| 14 | |
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 22 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 23 | ;; Boston, MA 02110-1301, USA. |
| 24 | |
| 25 | ;;; Commentary: |
| 26 | |
| 27 | ;; This facility is documented in the Emacs Manual. |
| 28 | |
| 29 | ;;; Code: |
| 30 | |
| 31 | (defcustom only-global-abbrevs nil |
| 32 | "Non-nil means user plans to use global abbrevs only. |
| 33 | This makes the commands that normally define mode-specific abbrevs |
| 34 | define global abbrevs instead." |
| 35 | :type 'boolean |
| 36 | :group 'abbrev-mode |
| 37 | :group 'convenience) |
| 38 | |
| 39 | (defun abbrev-mode (&optional arg) |
| 40 | "Toggle Abbrev mode in the current buffer. |
| 41 | With argument ARG, turn abbrev mode on iff ARG is positive. |
| 42 | In Abbrev mode, inserting an abbreviation causes it to expand |
| 43 | and be replaced by its expansion." |
| 44 | (interactive "P") |
| 45 | (setq abbrev-mode |
| 46 | (if (null arg) (not abbrev-mode) |
| 47 | (> (prefix-numeric-value arg) 0))) |
| 48 | (force-mode-line-update)) |
| 49 | |
| 50 | (defcustom abbrev-mode nil |
| 51 | "Enable or disable Abbrev mode. |
| 52 | Non-nil means automatically expand abbrevs as they are inserted. |
| 53 | |
| 54 | Setting this variable with `setq' changes it for the current buffer. |
| 55 | Changing it with \\[customize] sets the default value. |
| 56 | Interactively, use the command `abbrev-mode' |
| 57 | to enable or disable Abbrev mode in the current buffer." |
| 58 | :type 'boolean |
| 59 | :group 'abbrev-mode) |
| 60 | |
| 61 | \f |
| 62 | (defvar edit-abbrevs-map |
| 63 | (let ((map (make-sparse-keymap))) |
| 64 | (define-key map "\C-x\C-s" 'edit-abbrevs-redefine) |
| 65 | (define-key map "\C-c\C-c" 'edit-abbrevs-redefine) |
| 66 | map) |
| 67 | "Keymap used in `edit-abbrevs'.") |
| 68 | |
| 69 | (defun kill-all-abbrevs () |
| 70 | "Undefine all defined abbrevs." |
| 71 | (interactive) |
| 72 | (let ((tables abbrev-table-name-list)) |
| 73 | (while tables |
| 74 | (clear-abbrev-table (symbol-value (car tables))) |
| 75 | (setq tables (cdr tables))))) |
| 76 | |
| 77 | (defun copy-abbrev-table (table) |
| 78 | "Make a new abbrev-table with the same abbrevs as TABLE." |
| 79 | (let ((new-table (make-abbrev-table))) |
| 80 | (mapatoms |
| 81 | (lambda (symbol) |
| 82 | (define-abbrev new-table |
| 83 | (symbol-name symbol) |
| 84 | (symbol-value symbol) |
| 85 | (symbol-function symbol))) |
| 86 | table) |
| 87 | new-table)) |
| 88 | |
| 89 | (defun insert-abbrevs () |
| 90 | "Insert after point a description of all defined abbrevs. |
| 91 | Mark is set after the inserted text." |
| 92 | (interactive) |
| 93 | (push-mark |
| 94 | (save-excursion |
| 95 | (let ((tables abbrev-table-name-list)) |
| 96 | (while tables |
| 97 | (insert-abbrev-table-description (car tables) t) |
| 98 | (setq tables (cdr tables)))) |
| 99 | (point)))) |
| 100 | |
| 101 | (defun list-abbrevs (&optional local) |
| 102 | "Display a list of defined abbrevs. |
| 103 | If LOCAL is non-nil, interactively when invoked with a |
| 104 | prefix arg, display only local, i.e. mode-specific, abbrevs. |
| 105 | Otherwise display all abbrevs." |
| 106 | (interactive "P") |
| 107 | (display-buffer (prepare-abbrev-list-buffer local))) |
| 108 | |
| 109 | (defun abbrev-table-name (table) |
| 110 | "Value is the name of abbrev table TABLE." |
| 111 | (let ((tables abbrev-table-name-list) |
| 112 | found) |
| 113 | (while (and (not found) tables) |
| 114 | (when (eq (symbol-value (car tables)) table) |
| 115 | (setq found (car tables))) |
| 116 | (setq tables (cdr tables))) |
| 117 | found)) |
| 118 | |
| 119 | (defun prepare-abbrev-list-buffer (&optional local) |
| 120 | (save-excursion |
| 121 | (let ((table local-abbrev-table)) |
| 122 | (set-buffer (get-buffer-create "*Abbrevs*")) |
| 123 | (erase-buffer) |
| 124 | (if local |
| 125 | (insert-abbrev-table-description (abbrev-table-name table) t) |
| 126 | (dolist (table abbrev-table-name-list) |
| 127 | (insert-abbrev-table-description table t))) |
| 128 | (goto-char (point-min)) |
| 129 | (set-buffer-modified-p nil) |
| 130 | (edit-abbrevs-mode) |
| 131 | (current-buffer)))) |
| 132 | |
| 133 | (defun edit-abbrevs-mode () |
| 134 | "Major mode for editing the list of abbrev definitions. |
| 135 | \\{edit-abbrevs-map}" |
| 136 | (interactive) |
| 137 | (kill-all-local-variables) |
| 138 | (setq major-mode 'edit-abbrevs-mode) |
| 139 | (setq mode-name "Edit-Abbrevs") |
| 140 | (use-local-map edit-abbrevs-map) |
| 141 | (run-mode-hooks 'edit-abbrevs-mode-hook)) |
| 142 | |
| 143 | (defun edit-abbrevs () |
| 144 | "Alter abbrev definitions by editing a list of them. |
| 145 | Selects a buffer containing a list of abbrev definitions. |
| 146 | You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs |
| 147 | according to your editing. |
| 148 | Buffer contains a header line for each abbrev table, |
| 149 | which is the abbrev table name in parentheses. |
| 150 | This is followed by one line per abbrev in that table: |
| 151 | NAME USECOUNT EXPANSION HOOK |
| 152 | where NAME and EXPANSION are strings with quotes, |
| 153 | USECOUNT is an integer, and HOOK is any valid function |
| 154 | or may be omitted (it is usually omitted)." |
| 155 | (interactive) |
| 156 | (switch-to-buffer (prepare-abbrev-list-buffer))) |
| 157 | |
| 158 | (defun edit-abbrevs-redefine () |
| 159 | "Redefine abbrevs according to current buffer contents." |
| 160 | (interactive) |
| 161 | (define-abbrevs t) |
| 162 | (set-buffer-modified-p nil)) |
| 163 | |
| 164 | (defun define-abbrevs (&optional arg) |
| 165 | "Define abbrevs according to current visible buffer contents. |
| 166 | See documentation of `edit-abbrevs' for info on the format of the |
| 167 | text you must have in the buffer. |
| 168 | With argument, eliminate all abbrev definitions except |
| 169 | the ones defined from the buffer now." |
| 170 | (interactive "P") |
| 171 | (if arg (kill-all-abbrevs)) |
| 172 | (save-excursion |
| 173 | (goto-char (point-min)) |
| 174 | (while (and (not (eobp)) (re-search-forward "^(" nil t)) |
| 175 | (let* ((buf (current-buffer)) |
| 176 | (table (read buf)) |
| 177 | abbrevs name hook exp count sys) |
| 178 | (forward-line 1) |
| 179 | (while (progn (forward-line 1) |
| 180 | (not (eolp))) |
| 181 | (setq name (read buf) count (read buf)) |
| 182 | (if (equal count '(sys)) |
| 183 | (setq sys t count (read buf))) |
| 184 | (setq exp (read buf)) |
| 185 | (skip-chars-backward " \t\n\f") |
| 186 | (setq hook (if (not (eolp)) (read buf))) |
| 187 | (skip-chars-backward " \t\n\f") |
| 188 | (setq abbrevs (cons (list name exp hook count sys) abbrevs))) |
| 189 | (define-abbrev-table table abbrevs))))) |
| 190 | |
| 191 | (defun read-abbrev-file (&optional file quietly) |
| 192 | "Read abbrev definitions from file written with `write-abbrev-file'. |
| 193 | Optional argument FILE is the name of the file to read; |
| 194 | it defaults to the value of `abbrev-file-name'. |
| 195 | Optional second argument QUIETLY non-nil means don't display a message." |
| 196 | (interactive "fRead abbrev file: ") |
| 197 | (load (if (and file (> (length file) 0)) file abbrev-file-name) |
| 198 | nil quietly) |
| 199 | (setq abbrevs-changed nil)) |
| 200 | |
| 201 | (defun quietly-read-abbrev-file (&optional file) |
| 202 | "Read abbrev definitions from file written with `write-abbrev-file'. |
| 203 | Optional argument FILE is the name of the file to read; |
| 204 | it defaults to the value of `abbrev-file-name'. |
| 205 | Does not display any message." |
| 206 | ;(interactive "fRead abbrev file: ") |
| 207 | (read-abbrev-file file t)) |
| 208 | |
| 209 | (defun write-abbrev-file (&optional file) |
| 210 | "Write all user-level abbrev definitions to a file of Lisp code. |
| 211 | This does not include system abbrevs; it includes only the abbrev tables |
| 212 | listed in listed in `abbrev-table-name-list'. |
| 213 | The file written can be loaded in another session to define the same abbrevs. |
| 214 | The argument FILE is the file name to write. If omitted or nil, the file |
| 215 | specified in `abbrev-file-name' is used." |
| 216 | (interactive |
| 217 | (list |
| 218 | (read-file-name "Write abbrev file: " |
| 219 | (file-name-directory (expand-file-name abbrev-file-name)) |
| 220 | abbrev-file-name))) |
| 221 | (or (and file (> (length file) 0)) |
| 222 | (setq file abbrev-file-name)) |
| 223 | (let ((coding-system-for-write 'emacs-mule)) |
| 224 | (with-temp-file file |
| 225 | (insert ";;-*-coding: emacs-mule;-*-\n") |
| 226 | (dolist (table |
| 227 | ;; We sort the table in order to ease the automatic |
| 228 | ;; merging of different versions of the user's abbrevs |
| 229 | ;; file. This is useful, for example, for when the |
| 230 | ;; user keeps their home directory in a revision |
| 231 | ;; control system, and is therefore keeping multiple |
| 232 | ;; slightly-differing copies loosely synchronized. |
| 233 | (sort (copy-sequence abbrev-table-name-list) |
| 234 | (lambda (s1 s2) |
| 235 | (string< (symbol-name s1) |
| 236 | (symbol-name s2))))) |
| 237 | (insert-abbrev-table-description table nil))))) |
| 238 | \f |
| 239 | (defun add-mode-abbrev (arg) |
| 240 | "Define mode-specific abbrev for last word(s) before point. |
| 241 | Argument is how many words before point form the expansion; |
| 242 | or zero means the region is the expansion. |
| 243 | A negative argument means to undefine the specified abbrev. |
| 244 | Reads the abbreviation in the minibuffer. |
| 245 | |
| 246 | Don't use this function in a Lisp program; use `define-abbrev' instead." |
| 247 | (interactive "p") |
| 248 | (add-abbrev |
| 249 | (if only-global-abbrevs |
| 250 | global-abbrev-table |
| 251 | (or local-abbrev-table |
| 252 | (error "No per-mode abbrev table"))) |
| 253 | "Mode" arg)) |
| 254 | |
| 255 | (defun add-global-abbrev (arg) |
| 256 | "Define global (all modes) abbrev for last word(s) before point. |
| 257 | The prefix argument specifies the number of words before point that form the |
| 258 | expansion; or zero means the region is the expansion. |
| 259 | A negative argument means to undefine the specified abbrev. |
| 260 | This command uses the minibuffer to read the abbreviation. |
| 261 | |
| 262 | Don't use this function in a Lisp program; use `define-abbrev' instead." |
| 263 | (interactive "p") |
| 264 | (add-abbrev global-abbrev-table "Global" arg)) |
| 265 | |
| 266 | (defun add-abbrev (table type arg) |
| 267 | (let ((exp (and (>= arg 0) |
| 268 | (buffer-substring-no-properties |
| 269 | (point) |
| 270 | (if (= arg 0) (mark) |
| 271 | (save-excursion (forward-word (- arg)) (point)))))) |
| 272 | name) |
| 273 | (setq name |
| 274 | (read-string (format (if exp "%s abbrev for \"%s\": " |
| 275 | "Undefine %s abbrev: ") |
| 276 | type exp))) |
| 277 | (set-text-properties 0 (length name) nil name) |
| 278 | (if (or (null exp) |
| 279 | (not (abbrev-expansion name table)) |
| 280 | (y-or-n-p (format "%s expands to \"%s\"; redefine? " |
| 281 | name (abbrev-expansion name table)))) |
| 282 | (define-abbrev table (downcase name) exp)))) |
| 283 | |
| 284 | (defun inverse-add-mode-abbrev (n) |
| 285 | "Define last word before point as a mode-specific abbrev. |
| 286 | With prefix argument N, defines the Nth word before point. |
| 287 | This command uses the minibuffer to read the expansion. |
| 288 | Expands the abbreviation after defining it." |
| 289 | (interactive "p") |
| 290 | (inverse-add-abbrev |
| 291 | (if only-global-abbrevs |
| 292 | global-abbrev-table |
| 293 | (or local-abbrev-table |
| 294 | (error "No per-mode abbrev table"))) |
| 295 | "Mode" n)) |
| 296 | |
| 297 | (defun inverse-add-global-abbrev (n) |
| 298 | "Define last word before point as a global (mode-independent) abbrev. |
| 299 | With prefix argument N, defines the Nth word before point. |
| 300 | This command uses the minibuffer to read the expansion. |
| 301 | Expands the abbreviation after defining it." |
| 302 | (interactive "p") |
| 303 | (inverse-add-abbrev global-abbrev-table "Global" n)) |
| 304 | |
| 305 | (defun inverse-add-abbrev (table type arg) |
| 306 | (let (name exp start end) |
| 307 | (save-excursion |
| 308 | (forward-word (1+ (- arg))) |
| 309 | (setq end (point)) |
| 310 | (backward-word 1) |
| 311 | (setq start (point) |
| 312 | name (buffer-substring-no-properties start end))) |
| 313 | |
| 314 | (setq exp (read-string (format "%s expansion for \"%s\": " type name) |
| 315 | nil nil nil t)) |
| 316 | (when (or (not (abbrev-expansion name table)) |
| 317 | (y-or-n-p (format "%s expands to \"%s\"; redefine? " |
| 318 | name (abbrev-expansion name table)))) |
| 319 | (define-abbrev table (downcase name) exp) |
| 320 | (save-excursion |
| 321 | (goto-char end) |
| 322 | (expand-abbrev))))) |
| 323 | |
| 324 | (defun abbrev-prefix-mark (&optional arg) |
| 325 | "Mark current point as the beginning of an abbrev. |
| 326 | Abbrev to be expanded starts here rather than at beginning of word. |
| 327 | This way, you can expand an abbrev with a prefix: insert the prefix, |
| 328 | use this command, then insert the abbrev. This command inserts a |
| 329 | temporary hyphen after the prefix \(until the intended abbrev |
| 330 | expansion occurs). |
| 331 | If the prefix is itself an abbrev, this command expands it, unless |
| 332 | ARG is non-nil. Interactively, ARG is the prefix argument." |
| 333 | (interactive "P") |
| 334 | (or arg (expand-abbrev)) |
| 335 | (setq abbrev-start-location (point-marker) |
| 336 | abbrev-start-location-buffer (current-buffer)) |
| 337 | (insert "-")) |
| 338 | |
| 339 | (defun expand-region-abbrevs (start end &optional noquery) |
| 340 | "For abbrev occurrence in the region, offer to expand it. |
| 341 | The user is asked to type `y' or `n' for each occurrence. |
| 342 | A prefix argument means don't query; expand all abbrevs." |
| 343 | (interactive "r\nP") |
| 344 | (save-excursion |
| 345 | (goto-char start) |
| 346 | (let ((lim (- (point-max) end)) |
| 347 | pnt string) |
| 348 | (while (and (not (eobp)) |
| 349 | (progn (forward-word 1) |
| 350 | (<= (setq pnt (point)) (- (point-max) lim)))) |
| 351 | (if (abbrev-expansion |
| 352 | (setq string |
| 353 | (buffer-substring-no-properties |
| 354 | (save-excursion (forward-word -1) (point)) |
| 355 | pnt))) |
| 356 | (if (or noquery (y-or-n-p (format "Expand `%s'? " string))) |
| 357 | (expand-abbrev))))))) |
| 358 | |
| 359 | ;;; arch-tag: dbd6f3ae-dfe3-40ba-b00f-f9e3ff960df5 |
| 360 | ;;; abbrev.el ends here |