Mercurial > hg > xemacs-beta
annotate lisp/abbrev.el @ 5402:308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
| author | Mats Lidell <matsl@xemacs.org> |
|---|---|
| date | Thu, 14 Oct 2010 17:15:20 +0200 |
| parents | 74d00c7cc134 |
| children | b9167d522a9a |
| rev | line source |
|---|---|
| 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4319
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4319
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4319
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4319
diff
changeset
|
14 ;; option) any later version. |
| 428 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4319
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4319
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4319
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4319
diff
changeset
|
19 ;; for more details. |
| 428 | 20 |
| 21 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4319
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 23 |
| 24 ;;; Synched up with: FSF 19.34 (With some additions) | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This file is dumped with XEmacs. | |
| 29 | |
| 30 ;; This facility is documented in the Emacs Manual. | |
| 31 | |
| 32 ;;; Code: | |
| 33 | |
| 34 (defgroup abbrev nil | |
| 35 "Abbreviation handling, typing shortcuts, macros." | |
| 36 :tag "Abbreviations" | |
| 37 :group 'editing) | |
| 38 | |
| 814 | 39 (defcustom abbrev-mode nil |
| 428 | 40 "Word abbreviations mode." |
| 814 | 41 :initialize #'set-default |
| 42 :set #'(lambda (sym val) | |
| 43 (global-abbrev-mode (if val 1 0))) | |
| 428 | 44 :group 'abbrev) |
| 45 | |
| 814 | 46 (defcustom only-global-abbrevs nil |
| 47 "*Non-nil means user plans to use global abbrevs only. | |
| 428 | 48 Makes the commands to define mode-specific abbrevs define global ones instead." |
| 49 :type 'boolean | |
| 50 :group 'abbrev) | |
| 51 | |
| 814 | 52 (defcustom defining-abbrev-turns-on-abbrev-mode t |
| 53 "*NOn-nil turns on abbrev-mode whenever an abbrev is defined. | |
| 54 This occurs only when the user-level commands (e.g. `add-global-abbrev') | |
| 55 are used. abbrev-mode is turned on in all buffers or the current-buffer | |
| 56 only, depending on whether a global or mode-specific abbrev is defined." | |
| 57 ;;#### should turn on in all buffers of current mode in mode-specific abbrev! | |
| 58 :type 'boolean | |
| 59 :group 'abbrev) | |
| 60 | |
| 428 | 61 ;;; XEmacs: the following block of code is not in FSF |
| 62 (defvar abbrev-table-name-list '() | |
| 63 "List of symbols whose values are abbrev tables.") | |
| 64 | |
| 65 (defvar abbrevs-changed nil | |
| 66 "Set non-nil by defining or altering any word abbrevs. | |
| 67 This causes `save-some-buffers' to offer to save the abbrevs.") | |
| 68 | |
| 69 (defun make-abbrev-table () | |
| 70 "Return a new, empty abbrev table object." | |
| 71 (make-vector 59 0)) ; 59 is prime | |
| 72 | |
| 73 (defun clear-abbrev-table (table) | |
| 74 "Undefine all abbrevs in abbrev table TABLE, leaving it empty." | |
| 75 (fillarray table 0) | |
| 76 (setq abbrevs-changed t) | |
| 77 nil) | |
| 78 | |
| 444 | 79 (defun define-abbrev-table (table-name definitions) |
| 80 "Define TABLE-NAME (a symbol) as an abbrev table name. | |
| 428 | 81 Define abbrevs in it according to DEFINITIONS, which is a list of elements |
| 82 of the form (ABBREVNAME EXPANSION HOOK USECOUNT)." | |
| 444 | 83 (let ((table (and (boundp table-name) (symbol-value table-name)))) |
| 428 | 84 (cond ((vectorp table)) |
| 85 ((not table) | |
| 86 (setq table (make-abbrev-table)) | |
| 444 | 87 (set table-name table) |
| 3965 | 88 (setq abbrev-table-name-list |
| 89 (sort (cons table-name abbrev-table-name-list) | |
| 90 #'string-lessp))) | |
| 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 | |
| 3965 | 212 ; APA: Moved to c (ported function from GNU Emacs to src/abbrev.c) |
| 213 ; (defun insert-abbrev-table-description (name &optional human-readable) | |
| 214 ; "Insert before point a full description of abbrev table named NAME. | |
| 215 ; NAME is a symbol whose value is an abbrev table. | |
| 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." | |
| 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 "")) | |
| 428 | 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. | |
|
4319
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
422 This does not include system abbrevs; it includes only the abbrev tables |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
423 listed in listed in `abbrev-table-name-list'. |
| 428 | 424 The file written can be loaded in another session to define the same abbrevs. |
|
4319
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
425 The argument FILE is the file name to write. If omitted or nil, the file |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
426 specified in `abbrev-file-name' is used." |
| 428 | 427 (interactive |
| 428 (list | |
| 429 (read-file-name "Write abbrev file: " | |
| 430 (file-name-directory (expand-file-name abbrev-file-name)) | |
| 431 abbrev-file-name))) | |
| 432 (or (and file (> (length file) 0)) | |
| 433 (setq file abbrev-file-name)) | |
|
4319
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
434 (let ((coding-system-for-write 'escape-quoted)) |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
435 (with-temp-file file |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
436 ;; XEmacs change; not emacs-mule, and use the coding system |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
437 ;; escape-quoted resolves to, which will differ depending on whether |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
438 ;; the build is Mule or not. |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
439 (insert (format ";;-*-coding: %s;-*-\n" |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
440 (coding-system-name |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
441 (find-coding-system coding-system-for-write)))) |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
442 (dolist (table |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
443 ;; XEmacs change; we keep the table sorted at runtime, no |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
444 ;; need to sort it here. |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
445 abbrev-table-name-list) |
|
74d00c7cc134
Specify coding-system-for-write, add a coding cookie in #'write-abbrev-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4009
diff
changeset
|
446 (insert-abbrev-table-description table nil))))) |
| 428 | 447 |
| 442 | 448 (defun abbrev-string-to-be-defined (arg) |
| 449 "Return the string for which an abbrev will be defined. | |
| 450 ARG is the argument to `add-global-abbrev' or `add-mode-abbrev'." | |
| 451 (if (and (not arg) (region-active-p)) (setq arg 0) | |
| 452 (setq arg (prefix-numeric-value arg))) | |
| 453 (and (>= arg 0) | |
| 454 (buffer-substring | |
| 455 (point) | |
| 456 (if (= arg 0) (mark) | |
| 446 | 457 (save-excursion (backward-word arg) (point)))))) |
| 442 | 458 |
| 428 | 459 (defun add-mode-abbrev (arg) |
| 814 | 460 "Define mode-specific abbrev for region or last word(s) before point. |
| 461 If region active, use it as the expansion\; otherwise, choose the word | |
| 462 before point. A prefix argument specifies the number of words before point | |
| 463 that form the expansion; or zero means the text between point and mark is | |
| 464 the expansion. A negative argument means to undefine the specified abbrev. | |
| 465 This command uses the minibuffer to read the abbreviation. | |
| 428 | 466 |
| 467 Don't use this function in a Lisp program; use `define-abbrev' instead." | |
| 468 ;; XEmacs change: | |
| 469 (interactive "P") | |
| 470 (add-abbrev | |
| 471 (if only-global-abbrevs | |
| 472 global-abbrev-table | |
| 473 (or local-abbrev-table | |
| 474 (error "No per-mode abbrev table"))) | |
| 814 | 475 "Mode" arg) |
| 476 (if defining-abbrev-turns-on-abbrev-mode (abbrev-mode 1))) | |
| 428 | 477 |
| 478 (defun add-global-abbrev (arg) | |
| 814 | 479 "Define global (all modes) abbrev for region or last word(s) before point. |
| 480 If region active, use it as the expansion\; otherwise, choose the word | |
| 481 before point. A prefix argument specifies the number of words before point | |
| 482 that form the expansion; or zero means the text between point and mark is | |
| 483 the expansion. A negative argument means to undefine the specified abbrev. | |
| 428 | 484 This command uses the minibuffer to read the abbreviation. |
| 485 | |
| 486 Don't use this function in a Lisp program; use `define-abbrev' instead." | |
| 487 ;; XEmacs change: | |
| 488 (interactive "P") | |
| 814 | 489 (add-abbrev global-abbrev-table "Global" arg) |
| 490 (if defining-abbrev-turns-on-abbrev-mode (global-abbrev-mode 1))) | |
| 428 | 491 |
| 492 (defun add-abbrev (table type arg) | |
| 444 | 493 "Add an abbreviation to abbrev table TABLE. |
| 494 TYPE is a string describing in English the kind of abbrev this will be | |
| 495 (typically, \"global\" or \"mode-specific\"); this is used in | |
| 496 prompting the user. ARG is the number of words in the expansion. | |
| 497 | |
| 498 Return the symbol that internally represents the new abbrev, or nil if | |
| 499 the user declines to confirm redefining an existing abbrev." | |
| 428 | 500 ;; XEmacs change: |
| 442 | 501 (let ((exp (abbrev-string-to-be-defined arg)) |
| 428 | 502 name) |
| 503 (setq name | |
| 504 (read-string (format (if exp "%s abbrev for \"%s\": " | |
| 505 "Undefine %s abbrev: ") | |
| 506 type exp))) | |
| 507 (set-text-properties 0 (length name) nil name) | |
| 508 (if (or (null exp) | |
| 509 (not (abbrev-expansion name table)) | |
| 510 (y-or-n-p (format "%s expands to \"%s\"; redefine? " | |
| 511 name (abbrev-expansion name table)))) | |
| 512 (define-abbrev table (downcase name) exp)))) | |
| 513 | |
| 442 | 514 (defun inverse-abbrev-string-to-be-defined (arg) |
| 515 "Return the string for which an inverse abbrev will be defined. | |
| 516 ARG is the argument to `inverse-add-global-abbrev' or | |
| 517 `inverse-add-mode-abbrev'." | |
| 518 (save-excursion | |
| 446 | 519 (backward-word arg) |
| 442 | 520 (buffer-substring (point) (progn (forward-word 1) (point))))) |
| 521 | |
| 428 | 522 (defun inverse-add-mode-abbrev (arg) |
| 523 "Define last word before point as a mode-specific abbrev. | |
| 524 With prefix argument N, defines the Nth word before point. | |
| 525 This command uses the minibuffer to read the expansion. | |
| 526 Expands the abbreviation after defining it." | |
| 527 (interactive "p") | |
| 528 (inverse-add-abbrev | |
| 529 (if only-global-abbrevs | |
| 530 global-abbrev-table | |
| 531 (or local-abbrev-table | |
| 532 (error "No per-mode abbrev table"))) | |
| 814 | 533 "Mode" arg) |
| 534 (if defining-abbrev-turns-on-abbrev-mode (abbrev-mode 1))) | |
| 428 | 535 |
| 536 (defun inverse-add-global-abbrev (arg) | |
| 537 "Define last word before point as a global (mode-independent) abbrev. | |
| 538 With prefix argument N, defines the Nth word before point. | |
| 539 This command uses the minibuffer to read the expansion. | |
| 540 Expands the abbreviation after defining it." | |
| 541 (interactive "p") | |
| 814 | 542 (inverse-add-abbrev global-abbrev-table "Global" arg) |
| 543 (if defining-abbrev-turns-on-abbrev-mode (global-abbrev-mode 1))) | |
| 428 | 544 |
| 545 (defun inverse-add-abbrev (table type arg) | |
| 546 (let (name nameloc exp) | |
| 547 (save-excursion | |
| 446 | 548 (backward-word arg) |
| 428 | 549 (setq name (buffer-substring (point) (progn (forward-word 1) |
| 550 (setq nameloc (point)))))) | |
| 551 (set-text-properties 0 (length name) nil name) | |
| 552 (setq exp (read-string (format "%s expansion for \"%s\": " | |
| 553 type name))) | |
| 554 (if (or (not (abbrev-expansion name table)) | |
| 555 (y-or-n-p (format "%s expands to \"%s\"; redefine? " | |
| 556 name (abbrev-expansion name table)))) | |
| 557 (progn | |
| 558 (define-abbrev table (downcase name) exp) | |
| 559 (save-excursion | |
| 560 (goto-char nameloc) | |
| 561 (expand-abbrev)))))) | |
| 562 | |
| 563 (defun abbrev-prefix-mark (&optional arg) | |
| 564 "Mark current point as the beginning of an abbrev. | |
| 565 Abbrev to be expanded starts here rather than at beginning of word. | |
| 566 This way, you can expand an abbrev with a prefix: insert the prefix, | |
| 567 use this command, then insert the abbrev." | |
| 568 (interactive "P") | |
| 569 (or arg (expand-abbrev)) | |
| 570 (setq abbrev-start-location (point-marker) | |
| 571 abbrev-start-location-buffer (current-buffer)) | |
| 572 (let ((e (make-extent (point) (point)))) | |
| 573 (set-extent-begin-glyph e (make-glyph [string :data "-"])))) | |
| 574 | |
| 575 (defun expand-region-abbrevs (start end &optional noquery) | |
| 576 "For abbrev occurrence in the region, offer to expand it. | |
| 577 The user is asked to type y or n for each occurrence. | |
| 578 A prefix argument means don't query; expand all abbrevs. | |
| 579 If called from a Lisp program, arguments are START END &optional NOQUERY." | |
| 580 (interactive "r\nP") | |
| 581 (save-excursion | |
| 582 (goto-char start) | |
| 583 (let ((lim (- (point-max) end)) | |
| 584 pnt string) | |
| 585 (while (and (not (eobp)) | |
| 586 (progn (forward-word 1) | |
| 587 (<= (setq pnt (point)) (- (point-max) lim)))) | |
| 588 (if (abbrev-expansion | |
| 589 (setq string | |
| 4009 | 590 (downcase (buffer-substring |
| 591 (save-excursion (backward-word) (point)) | |
| 592 pnt)))) | |
| 428 | 593 (if (or noquery (y-or-n-p (format "Expand `%s'? " string))) |
| 594 (expand-abbrev))))))) | |
| 595 | |
| 596 ;;; abbrev.el ends here |