428
+ − 1 ;;; abbrev.el --- abbrev mode commands for Emacs
+ − 2
+ − 3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1997 Free Software Foundation, Inc.
814
+ − 4 ;; Copyright (C) 2002 Ben Wing.
428
+ − 5
+ − 6 ;; Maintainer: XEmacs Development Team
+ − 7 ;; Keywords: abbrev, dumped
+ − 8
+ − 9 ;; This file is part of XEmacs.
+ − 10
+ − 11 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 12 ;; under the terms of the GNU General Public License as published by
+ − 13 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 14 ;; any later version.
+ − 15
+ − 16 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 19 ;; General Public License for more details.
+ − 20
+ − 21 ;; You should have received a copy of the GNU General Public License
+ − 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
+ − 23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ − 24 ;; 02111-1307, USA.
+ − 25
+ − 26 ;;; Synched up with: FSF 19.34 (With some additions)
+ − 27
+ − 28 ;;; Commentary:
+ − 29
+ − 30 ;; This file is dumped with XEmacs.
+ − 31
+ − 32 ;; This facility is documented in the Emacs Manual.
+ − 33
+ − 34 ;;; Code:
+ − 35
+ − 36 (defgroup abbrev nil
+ − 37 "Abbreviation handling, typing shortcuts, macros."
+ − 38 :tag "Abbreviations"
+ − 39 :group 'editing)
+ − 40
814
+ − 41 (defcustom abbrev-mode nil
428
+ − 42 "Word abbreviations mode."
814
+ − 43 :initialize #'set-default
+ − 44 :set #'(lambda (sym val)
+ − 45 (global-abbrev-mode (if val 1 0)))
428
+ − 46 :group 'abbrev)
+ − 47
814
+ − 48 (defcustom only-global-abbrevs nil
+ − 49 "*Non-nil means user plans to use global abbrevs only.
428
+ − 50 Makes the commands to define mode-specific abbrevs define global ones instead."
+ − 51 :type 'boolean
+ − 52 :group 'abbrev)
+ − 53
814
+ − 54 (defcustom defining-abbrev-turns-on-abbrev-mode t
+ − 55 "*NOn-nil turns on abbrev-mode whenever an abbrev is defined.
+ − 56 This occurs only when the user-level commands (e.g. `add-global-abbrev')
+ − 57 are used. abbrev-mode is turned on in all buffers or the current-buffer
+ − 58 only, depending on whether a global or mode-specific abbrev is defined."
+ − 59 ;;#### should turn on in all buffers of current mode in mode-specific abbrev!
+ − 60 :type 'boolean
+ − 61 :group 'abbrev)
+ − 62
428
+ − 63 ;;; XEmacs: the following block of code is not in FSF
+ − 64 (defvar abbrev-table-name-list '()
+ − 65 "List of symbols whose values are abbrev tables.")
+ − 66
+ − 67 (defvar abbrevs-changed nil
+ − 68 "Set non-nil by defining or altering any word abbrevs.
+ − 69 This causes `save-some-buffers' to offer to save the abbrevs.")
+ − 70
+ − 71 (defun make-abbrev-table ()
+ − 72 "Return a new, empty abbrev table object."
+ − 73 (make-vector 59 0)) ; 59 is prime
+ − 74
+ − 75 (defun clear-abbrev-table (table)
+ − 76 "Undefine all abbrevs in abbrev table TABLE, leaving it empty."
+ − 77 (fillarray table 0)
+ − 78 (setq abbrevs-changed t)
+ − 79 nil)
+ − 80
444
+ − 81 (defun define-abbrev-table (table-name definitions)
+ − 82 "Define TABLE-NAME (a symbol) as an abbrev table name.
428
+ − 83 Define abbrevs in it according to DEFINITIONS, which is a list of elements
+ − 84 of the form (ABBREVNAME EXPANSION HOOK USECOUNT)."
444
+ − 85 (let ((table (and (boundp table-name) (symbol-value table-name))))
428
+ − 86 (cond ((vectorp table))
+ − 87 ((not table)
+ − 88 (setq table (make-abbrev-table))
444
+ − 89 (set table-name table)
+ − 90 (setq abbrev-table-name-list (cons table-name abbrev-table-name-list)))
428
+ − 91 (t
444
+ − 92 (setq table (wrong-type-argument 'vectorp table))
+ − 93 (set table-name table)))
+ − 94 (while definitions
+ − 95 (apply (function define-abbrev) table (car definitions))
+ − 96 (setq definitions (cdr definitions)))))
428
+ − 97
+ − 98 (defun define-abbrev (table name &optional expansion hook count)
+ − 99 "Define an abbrev in TABLE named NAME, to expand to EXPANSION or call HOOK.
+ − 100 NAME and EXPANSION are strings. Hook is a function or `nil'.
+ − 101 To undefine an abbrev, define it with an expansion of `nil'."
446
+ − 102 (check-type expansion (or null string))
+ − 103 (check-type count (or null integer))
+ − 104 (check-type table vector)
428
+ − 105 (let* ((sym (intern name table))
+ − 106 (oexp (and (boundp sym) (symbol-value sym)))
+ − 107 (ohook (and (fboundp sym) (symbol-function sym))))
+ − 108 (unless (and (equal ohook hook)
+ − 109 (stringp oexp)
+ − 110 (stringp expansion)
+ − 111 (string-equal oexp expansion))
+ − 112 (setq abbrevs-changed t)
+ − 113 ;; If there is a non-word character in the string, set the flag.
+ − 114 (if (string-match "\\W" name)
+ − 115 (set (intern " " table) nil)))
+ − 116 (set sym expansion)
+ − 117 (fset sym hook)
+ − 118 (setplist sym (or count 0))
+ − 119 name))
+ − 120
+ − 121
+ − 122 ;; Fixup stuff from bootstrap def of define-abbrev-table in subr.el
+ − 123 (let ((l abbrev-table-name-list))
+ − 124 (while l
+ − 125 (let ((fixup (car l)))
+ − 126 (if (consp fixup)
+ − 127 (progn
+ − 128 (setq abbrev-table-name-list (delq fixup abbrev-table-name-list))
+ − 129 (define-abbrev-table (car fixup) (cdr fixup))))
+ − 130 (setq l (cdr l))))
+ − 131 ;; These are no longer initialized by C code
+ − 132 (if (not global-abbrev-table)
+ − 133 (progn
+ − 134 (setq global-abbrev-table (make-abbrev-table))
+ − 135 (setq abbrev-table-name-list (cons 'global-abbrev-table
+ − 136 abbrev-table-name-list))))
+ − 137 (if (not fundamental-mode-abbrev-table)
+ − 138 (progn
+ − 139 (setq fundamental-mode-abbrev-table (make-abbrev-table))
+ − 140 (setq abbrev-table-name-list (cons 'fundamental-mode-abbrev-table
+ − 141 abbrev-table-name-list))))
+ − 142 (and (eq major-mode 'fundamental-mode)
+ − 143 (not local-abbrev-table)
+ − 144 (setq local-abbrev-table fundamental-mode-abbrev-table)))
+ − 145
+ − 146
+ − 147 (defun define-global-abbrev (name expansion)
+ − 148 "Define ABBREV as a global abbreviation for EXPANSION."
+ − 149 (interactive "sDefine global abbrev: \nsExpansion for %s: ")
+ − 150 (define-abbrev global-abbrev-table
+ − 151 (downcase name) expansion nil 0))
+ − 152
+ − 153 (defun define-mode-abbrev (name expansion)
+ − 154 "Define ABBREV as a mode-specific abbreviation for EXPANSION."
+ − 155 (interactive "sDefine mode abbrev: \nsExpansion for %s: ")
+ − 156 (define-abbrev (or local-abbrev-table
+ − 157 (error "Major mode has no abbrev table"))
+ − 158 (downcase name) expansion nil 0))
+ − 159
+ − 160 (defun abbrev-symbol (abbrev &optional table)
+ − 161 "Return the symbol representing abbrev named ABBREV.
+ − 162 This symbol's name is ABBREV, but it is not the canonical symbol of that name;
+ − 163 it is interned in an abbrev-table rather than the normal obarray.
+ − 164 The value is nil if that abbrev is not defined.
+ − 165 Optional second arg TABLE is abbrev table to look it up in.
+ − 166 The default is to try buffer's mode-specific abbrev table, then global table."
+ − 167 (let ((frob (function (lambda (table)
+ − 168 (let ((sym (intern-soft abbrev table)))
+ − 169 (if (and (boundp sym)
+ − 170 (stringp (symbol-value sym)))
+ − 171 sym
+ − 172 nil))))))
+ − 173 (if table
+ − 174 (funcall frob table)
+ − 175 (or (and local-abbrev-table
+ − 176 (funcall frob local-abbrev-table))
+ − 177 (funcall frob global-abbrev-table)))))
+ − 178
+ − 179 (defun abbrev-expansion (abbrev &optional table)
+ − 180 "Return the string that ABBREV expands into in the current buffer.
+ − 181 Optionally specify an abbrev table as second arg;
+ − 182 then ABBREV is looked up in that table only."
+ − 183 (let ((sym (abbrev-symbol abbrev table)))
+ − 184 (if sym
+ − 185 (symbol-value sym)
+ − 186 nil)))
+ − 187
+ − 188 (defun unexpand-abbrev ()
+ − 189 "Undo the expansion of the last abbrev that expanded.
+ − 190 This differs from ordinary undo in that other editing done since then
+ − 191 is not undone."
+ − 192 (interactive)
+ − 193 (if (or (< last-abbrev-location (point-min))
+ − 194 (> last-abbrev-location (point-max))
+ − 195 (not (stringp last-abbrev-text)))
+ − 196 nil
+ − 197 (let* ((opoint (point))
+ − 198 (val (symbol-value last-abbrev))
+ − 199 (adjust (length val)))
+ − 200 ;; This isn't correct if (symbol-function last-abbrev-text)
+ − 201 ;; was used to do the expansion
+ − 202 (goto-char last-abbrev-location)
+ − 203 (delete-region last-abbrev-location (+ last-abbrev-location adjust))
+ − 204 (insert last-abbrev-text)
+ − 205 (setq adjust (- adjust (length last-abbrev-text)))
+ − 206 (setq last-abbrev-text nil)
+ − 207 (if (< last-abbrev-location opoint)
+ − 208 (goto-char (- opoint adjust))
+ − 209 (goto-char opoint)))))
+ − 210
+ − 211
+ − 212
444
+ − 213 (defun insert-abbrev-table-description (name &optional human-readable)
428
+ − 214 "Insert before point a full description of abbrev table named NAME.
+ − 215 NAME is a symbol whose value is an abbrev table.
444
+ − 216 If optional second argument HUMAN-READABLE is non-nil, insert a
+ − 217 human-readable description. Otherwise the description is an
+ − 218 expression, a call to `define-abbrev-table', which would define the
+ − 219 abbrev table NAME exactly as it is currently defined."
428
+ − 220 (let ((table (symbol-value name))
+ − 221 (stream (current-buffer)))
+ − 222 (message "Abbrev-table %s..." name)
+ − 223 (if human-readable
+ − 224 (progn
+ − 225 (prin1 (list name) stream)
+ − 226 ;; Need two terpri's or cretinous edit-abbrevs blows out
+ − 227 (terpri stream)
+ − 228 (terpri stream)
+ − 229 (mapatoms (function (lambda (sym)
+ − 230 (if (symbol-value sym)
+ − 231 (let* ((n (prin1-to-string (symbol-name sym)))
+ − 232 (pos (length n)))
+ − 233 (princ n stream)
+ − 234 (while (< pos 14)
+ − 235 (write-char ?\ stream)
+ − 236 (setq pos (1+ pos)))
+ − 237 (princ (format " %-5S " (symbol-plist sym))
+ − 238 stream)
+ − 239 (if (not (symbol-function sym))
+ − 240 (prin1 (symbol-value sym) stream)
+ − 241 (progn
+ − 242 (setq n (prin1-to-string (symbol-value sym))
+ − 243 pos (+ pos 6 (length n)))
+ − 244 (princ n stream)
+ − 245 (while (< pos 45)
+ − 246 (write-char ?\ stream)
+ − 247 (setq pos (1+ pos)))
+ − 248 (prin1 (symbol-function sym) stream)))
+ − 249 (terpri stream)))))
+ − 250 table)
+ − 251 (terpri stream))
+ − 252 (progn
+ − 253 (princ "\(define-abbrev-table '" stream)
+ − 254 (prin1 name stream)
+ − 255 (princ " '\(\n" stream)
+ − 256 (mapatoms (function (lambda (sym)
+ − 257 (if (symbol-value sym)
+ − 258 (progn
+ − 259 (princ " " stream)
+ − 260 (prin1 (list (symbol-name sym)
+ − 261 (symbol-value sym)
+ − 262 (symbol-function sym)
+ − 263 (symbol-plist sym))
+ − 264 stream)
+ − 265 (terpri stream)))))
+ − 266 table)
+ − 267 (princ " \)\)\n" stream)))
+ − 268 (terpri stream))
+ − 269 (message ""))
+ − 270 ;;; End code not in FSF
+ − 271
+ − 272 (defun abbrev-mode (arg)
+ − 273 "Toggle abbrev mode.
444
+ − 274 With argument ARG, enable abbrev mode if ARG is positive, else disable.
428
+ − 275 In abbrev mode, inserting an abbreviation causes it to expand
+ − 276 and be replaced by its expansion."
+ − 277 (interactive "P")
+ − 278 (setq abbrev-mode
+ − 279 (if (null arg) (not abbrev-mode)
+ − 280 (> (prefix-numeric-value arg) 0)))
+ − 281 ;; XEmacs change
+ − 282 (redraw-modeline))
+ − 283
814
+ − 284 ;; XEmacs change
+ − 285 (defun global-abbrev-mode (arg)
+ − 286 "Toggle abbrev mode in all buffers.
+ − 287 With argument ARG, enable abbrev mode globally if ARG is positive, else
+ − 288 disable. In abbrev mode, inserting an abbreviation causes it to expand
+ − 289 and be replaced by its expansion."
+ − 290 (interactive "P")
+ − 291 (let ((newval (if (null arg) (not abbrev-mode)
+ − 292 (> (prefix-numeric-value arg) 0))))
+ − 293 (setq-default abbrev-mode newval)
+ − 294 (loop for buf being the buffers do
+ − 295 (if (not (eq (symbol-value-in-buffer 'abbrev-mode buf) newval))
+ − 296 (with-current-buffer buf
+ − 297 (setq abbrev-mode newval)))))
+ − 298 (redraw-modeline))
+ − 299
428
+ − 300
+ − 301 (defvar edit-abbrevs-map nil
+ − 302 "Keymap used in edit-abbrevs.")
+ − 303 (if edit-abbrevs-map
+ − 304 nil
+ − 305 (setq edit-abbrevs-map (make-sparse-keymap))
+ − 306 ;; XEmacs change
+ − 307 (set-keymap-name edit-abbrevs-map 'edit-abbrevs-map)
+ − 308 (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine)
+ − 309 (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine))
+ − 310
+ − 311 (defun kill-all-abbrevs ()
+ − 312 "Undefine all defined abbrevs."
+ − 313 (interactive)
+ − 314 (let ((tables abbrev-table-name-list))
+ − 315 (while tables
+ − 316 (clear-abbrev-table (symbol-value (car tables)))
+ − 317 (setq tables (cdr tables)))))
+ − 318
+ − 319 (defun insert-abbrevs ()
+ − 320 "Insert after point a description of all defined abbrevs.
+ − 321 Mark is set after the inserted text."
+ − 322 (interactive)
+ − 323 (push-mark
+ − 324 (save-excursion
+ − 325 (let ((tables abbrev-table-name-list))
+ − 326 (while tables
+ − 327 (insert-abbrev-table-description (car tables) t)
+ − 328 (setq tables (cdr tables))))
+ − 329 (point))))
+ − 330
+ − 331 (defun list-abbrevs ()
+ − 332 "Display a list of all defined abbrevs."
+ − 333 (interactive)
+ − 334 (display-buffer (prepare-abbrev-list-buffer)))
+ − 335
+ − 336 (defun prepare-abbrev-list-buffer ()
+ − 337 (save-excursion
+ − 338 (set-buffer (get-buffer-create "*Abbrevs*"))
+ − 339 (erase-buffer)
+ − 340 (let ((tables abbrev-table-name-list))
+ − 341 (while tables
+ − 342 (insert-abbrev-table-description (car tables) t)
+ − 343 (setq tables (cdr tables))))
+ − 344 (goto-char (point-min))
+ − 345 (set-buffer-modified-p nil)
+ − 346 (edit-abbrevs-mode))
+ − 347 (get-buffer-create "*Abbrevs*"))
+ − 348
+ − 349 (defun edit-abbrevs-mode ()
+ − 350 "Major mode for editing the list of abbrev definitions.
+ − 351 \\{edit-abbrevs-map}"
+ − 352 (interactive)
+ − 353 (setq major-mode 'edit-abbrevs-mode)
+ − 354 (setq mode-name "Edit-Abbrevs")
+ − 355 (use-local-map edit-abbrevs-map))
+ − 356
+ − 357 (defun edit-abbrevs ()
+ − 358 "Alter abbrev definitions by editing a list of them.
+ − 359 Selects a buffer containing a list of abbrev definitions.
+ − 360 You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs
+ − 361 according to your editing.
+ − 362 Buffer contains a header line for each abbrev table,
+ − 363 which is the abbrev table name in parentheses.
+ − 364 This is followed by one line per abbrev in that table:
+ − 365 NAME USECOUNT EXPANSION HOOK
+ − 366 where NAME and EXPANSION are strings with quotes,
+ − 367 USECOUNT is an integer, and HOOK is any valid function
+ − 368 or may be omitted (it is usually omitted)."
+ − 369 (interactive)
+ − 370 (switch-to-buffer (prepare-abbrev-list-buffer)))
+ − 371
+ − 372 (defun edit-abbrevs-redefine ()
+ − 373 "Redefine abbrevs according to current buffer contents."
+ − 374 (interactive)
+ − 375 (define-abbrevs t)
+ − 376 (set-buffer-modified-p nil))
+ − 377
+ − 378 (defun define-abbrevs (&optional arg)
+ − 379 "Define abbrevs according to current visible buffer contents.
+ − 380 See documentation of `edit-abbrevs' for info on the format of the
+ − 381 text you must have in the buffer.
+ − 382 With argument, eliminate all abbrev definitions except
+ − 383 the ones defined from the buffer now."
+ − 384 (interactive "P")
+ − 385 (if arg (kill-all-abbrevs))
+ − 386 (save-excursion
+ − 387 (goto-char (point-min))
+ − 388 (while (and (not (eobp)) (re-search-forward "^(" nil t))
+ − 389 (let* ((buf (current-buffer))
+ − 390 (table (read buf))
+ − 391 abbrevs name hook exp count)
+ − 392 (forward-line 1)
+ − 393 (while (progn (forward-line 1)
+ − 394 (not (eolp)))
+ − 395 (setq name (read buf) count (read buf) exp (read buf))
+ − 396 (skip-chars-backward " \t\n\f")
+ − 397 (setq hook (if (not (eolp)) (read buf)))
+ − 398 (skip-chars-backward " \t\n\f")
+ − 399 (setq abbrevs (cons (list name exp hook count) abbrevs)))
+ − 400 (define-abbrev-table table abbrevs)))))
+ − 401
+ − 402 (defun read-abbrev-file (&optional file quietly)
+ − 403 "Read abbrev definitions from file written with `write-abbrev-file'.
+ − 404 Optional argument FILE is the name of the file to read;
+ − 405 it defaults to the value of `abbrev-file-name'.
+ − 406 Optional second argument QUIETLY non-nil means don't print anything."
+ − 407 (interactive "fRead abbrev file: ")
+ − 408 (load (if (and file (> (length file) 0)) file abbrev-file-name)
+ − 409 nil quietly)
+ − 410 (setq save-abbrevs t abbrevs-changed nil))
+ − 411
+ − 412 (defun quietly-read-abbrev-file (&optional file)
444
+ − 413 "Read abbrev definitions from file written with `write-abbrev-file'.
428
+ − 414 Optional argument FILE is the name of the file to read;
+ − 415 it defaults to the value of `abbrev-file-name'.
+ − 416 Does not print anything."
+ − 417 ;(interactive "fRead abbrev file: ")
+ − 418 (read-abbrev-file file t))
+ − 419
+ − 420 (defun write-abbrev-file (file)
+ − 421 "Write all abbrev definitions to a file of Lisp code.
+ − 422 The file written can be loaded in another session to define the same abbrevs.
+ − 423 The argument FILE is the file name to write."
+ − 424 (interactive
+ − 425 (list
+ − 426 (read-file-name "Write abbrev file: "
+ − 427 (file-name-directory (expand-file-name abbrev-file-name))
+ − 428 abbrev-file-name)))
+ − 429 (or (and file (> (length file) 0))
+ − 430 (setq file abbrev-file-name))
+ − 431 (save-excursion
+ − 432 (set-buffer (get-buffer-create " write-abbrev-file"))
+ − 433 (erase-buffer)
+ − 434 (let ((tables abbrev-table-name-list))
+ − 435 (while tables
+ − 436 (insert-abbrev-table-description (car tables) nil)
+ − 437 (setq tables (cdr tables))))
+ − 438 (write-region 1 (point-max) file)
+ − 439 (erase-buffer)))
+ − 440
442
+ − 441 (defun abbrev-string-to-be-defined (arg)
+ − 442 "Return the string for which an abbrev will be defined.
+ − 443 ARG is the argument to `add-global-abbrev' or `add-mode-abbrev'."
+ − 444 (if (and (not arg) (region-active-p)) (setq arg 0)
+ − 445 (setq arg (prefix-numeric-value arg)))
+ − 446 (and (>= arg 0)
+ − 447 (buffer-substring
+ − 448 (point)
+ − 449 (if (= arg 0) (mark)
446
+ − 450 (save-excursion (backward-word arg) (point))))))
442
+ − 451
428
+ − 452 (defun add-mode-abbrev (arg)
814
+ − 453 "Define mode-specific abbrev for region or last word(s) before point.
+ − 454 If region active, use it as the expansion\; otherwise, choose the word
+ − 455 before point. A prefix argument specifies the number of words before point
+ − 456 that form the expansion; or zero means the text between point and mark is
+ − 457 the expansion. A negative argument means to undefine the specified abbrev.
+ − 458 This command uses the minibuffer to read the abbreviation.
428
+ − 459
+ − 460 Don't use this function in a Lisp program; use `define-abbrev' instead."
+ − 461 ;; XEmacs change:
+ − 462 (interactive "P")
+ − 463 (add-abbrev
+ − 464 (if only-global-abbrevs
+ − 465 global-abbrev-table
+ − 466 (or local-abbrev-table
+ − 467 (error "No per-mode abbrev table")))
814
+ − 468 "Mode" arg)
+ − 469 (if defining-abbrev-turns-on-abbrev-mode (abbrev-mode 1)))
428
+ − 470
+ − 471 (defun add-global-abbrev (arg)
814
+ − 472 "Define global (all modes) abbrev for region or last word(s) before point.
+ − 473 If region active, use it as the expansion\; otherwise, choose the word
+ − 474 before point. A prefix argument specifies the number of words before point
+ − 475 that form the expansion; or zero means the text between point and mark is
+ − 476 the expansion. A negative argument means to undefine the specified abbrev.
428
+ − 477 This command uses the minibuffer to read the abbreviation.
+ − 478
+ − 479 Don't use this function in a Lisp program; use `define-abbrev' instead."
+ − 480 ;; XEmacs change:
+ − 481 (interactive "P")
814
+ − 482 (add-abbrev global-abbrev-table "Global" arg)
+ − 483 (if defining-abbrev-turns-on-abbrev-mode (global-abbrev-mode 1)))
428
+ − 484
+ − 485 (defun add-abbrev (table type arg)
444
+ − 486 "Add an abbreviation to abbrev table TABLE.
+ − 487 TYPE is a string describing in English the kind of abbrev this will be
+ − 488 (typically, \"global\" or \"mode-specific\"); this is used in
+ − 489 prompting the user. ARG is the number of words in the expansion.
+ − 490
+ − 491 Return the symbol that internally represents the new abbrev, or nil if
+ − 492 the user declines to confirm redefining an existing abbrev."
428
+ − 493 ;; XEmacs change:
442
+ − 494 (let ((exp (abbrev-string-to-be-defined arg))
428
+ − 495 name)
+ − 496 (setq name
+ − 497 (read-string (format (if exp "%s abbrev for \"%s\": "
+ − 498 "Undefine %s abbrev: ")
+ − 499 type exp)))
+ − 500 (set-text-properties 0 (length name) nil name)
+ − 501 (if (or (null exp)
+ − 502 (not (abbrev-expansion name table))
+ − 503 (y-or-n-p (format "%s expands to \"%s\"; redefine? "
+ − 504 name (abbrev-expansion name table))))
+ − 505 (define-abbrev table (downcase name) exp))))
+ − 506
442
+ − 507 (defun inverse-abbrev-string-to-be-defined (arg)
+ − 508 "Return the string for which an inverse abbrev will be defined.
+ − 509 ARG is the argument to `inverse-add-global-abbrev' or
+ − 510 `inverse-add-mode-abbrev'."
+ − 511 (save-excursion
446
+ − 512 (backward-word arg)
442
+ − 513 (buffer-substring (point) (progn (forward-word 1) (point)))))
+ − 514
428
+ − 515 (defun inverse-add-mode-abbrev (arg)
+ − 516 "Define last word before point as a mode-specific abbrev.
+ − 517 With prefix argument N, defines the Nth word before point.
+ − 518 This command uses the minibuffer to read the expansion.
+ − 519 Expands the abbreviation after defining it."
+ − 520 (interactive "p")
+ − 521 (inverse-add-abbrev
+ − 522 (if only-global-abbrevs
+ − 523 global-abbrev-table
+ − 524 (or local-abbrev-table
+ − 525 (error "No per-mode abbrev table")))
814
+ − 526 "Mode" arg)
+ − 527 (if defining-abbrev-turns-on-abbrev-mode (abbrev-mode 1)))
428
+ − 528
+ − 529 (defun inverse-add-global-abbrev (arg)
+ − 530 "Define last word before point as a global (mode-independent) abbrev.
+ − 531 With prefix argument N, defines the Nth word before point.
+ − 532 This command uses the minibuffer to read the expansion.
+ − 533 Expands the abbreviation after defining it."
+ − 534 (interactive "p")
814
+ − 535 (inverse-add-abbrev global-abbrev-table "Global" arg)
+ − 536 (if defining-abbrev-turns-on-abbrev-mode (global-abbrev-mode 1)))
428
+ − 537
+ − 538 (defun inverse-add-abbrev (table type arg)
+ − 539 (let (name nameloc exp)
+ − 540 (save-excursion
446
+ − 541 (backward-word arg)
428
+ − 542 (setq name (buffer-substring (point) (progn (forward-word 1)
+ − 543 (setq nameloc (point))))))
+ − 544 (set-text-properties 0 (length name) nil name)
+ − 545 (setq exp (read-string (format "%s expansion for \"%s\": "
+ − 546 type name)))
+ − 547 (if (or (not (abbrev-expansion name table))
+ − 548 (y-or-n-p (format "%s expands to \"%s\"; redefine? "
+ − 549 name (abbrev-expansion name table))))
+ − 550 (progn
+ − 551 (define-abbrev table (downcase name) exp)
+ − 552 (save-excursion
+ − 553 (goto-char nameloc)
+ − 554 (expand-abbrev))))))
+ − 555
+ − 556 (defun abbrev-prefix-mark (&optional arg)
+ − 557 "Mark current point as the beginning of an abbrev.
+ − 558 Abbrev to be expanded starts here rather than at beginning of word.
+ − 559 This way, you can expand an abbrev with a prefix: insert the prefix,
+ − 560 use this command, then insert the abbrev."
+ − 561 (interactive "P")
+ − 562 (or arg (expand-abbrev))
+ − 563 (setq abbrev-start-location (point-marker)
+ − 564 abbrev-start-location-buffer (current-buffer))
+ − 565 (let ((e (make-extent (point) (point))))
+ − 566 (set-extent-begin-glyph e (make-glyph [string :data "-"]))))
+ − 567
+ − 568 (defun expand-region-abbrevs (start end &optional noquery)
+ − 569 "For abbrev occurrence in the region, offer to expand it.
+ − 570 The user is asked to type y or n for each occurrence.
+ − 571 A prefix argument means don't query; expand all abbrevs.
+ − 572 If called from a Lisp program, arguments are START END &optional NOQUERY."
+ − 573 (interactive "r\nP")
+ − 574 (save-excursion
+ − 575 (goto-char start)
+ − 576 (let ((lim (- (point-max) end))
+ − 577 pnt string)
+ − 578 (while (and (not (eobp))
+ − 579 (progn (forward-word 1)
+ − 580 (<= (setq pnt (point)) (- (point-max) lim))))
+ − 581 (if (abbrev-expansion
+ − 582 (setq string
+ − 583 (buffer-substring
446
+ − 584 (save-excursion (backward-word) (point))
428
+ − 585 pnt)))
+ − 586 (if (or noquery (y-or-n-p (format "Expand `%s'? " string)))
+ − 587 (expand-abbrev)))))))
+ − 588
+ − 589 ;;; abbrev.el ends here