Mercurial > hg > xemacs-beta
annotate lisp/abbrev.el @ 5618:cc1ec4c93a67
Improve Lisp style in a few places, select.el
lisp/ChangeLog addition:
2011-12-23 Aidan Kehoe <kehoea@parhasard.net>
* select.el (activate-region-as-selection):
* select.el (select-make-extent-for-selection):
* select.el (select-convert-in):
* select.el (select-convert-out):
* select.el (select-coerce):
* select.el (select-convert-to-targets):
Improve Lisp style in a few places here; don't re-implement
#'delete-duplicates, use #'funcall instead of consing up a list to
pass to #'apply.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 23 Dec 2011 10:34:40 +0000 |
| parents | b9167d522a9a |
| children |
| 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 | |
|
5284
d27c1ee1943b
Make the order of preloaded-file-list more sane.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4319
diff
changeset
|
121 (define-abbrev-table 'fundamental-mode-abbrev-table nil) |
|
d27c1ee1943b
Make the order of preloaded-file-list more sane.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4319
diff
changeset
|
122 (and (eq major-mode 'fundamental-mode) |
|
d27c1ee1943b
Make the order of preloaded-file-list more sane.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4319
diff
changeset
|
123 (not local-abbrev-table) |
|
d27c1ee1943b
Make the order of preloaded-file-list more sane.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4319
diff
changeset
|
124 (setq local-abbrev-table fundamental-mode-abbrev-table)) |
| 428 | 125 |
|
5284
d27c1ee1943b
Make the order of preloaded-file-list more sane.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4319
diff
changeset
|
126 (define-abbrev-table 'global-abbrev-table nil) |
| 428 | 127 |
| 128 (defun define-global-abbrev (name expansion) | |
| 129 "Define ABBREV as a global abbreviation for EXPANSION." | |
| 130 (interactive "sDefine global abbrev: \nsExpansion for %s: ") | |
| 131 (define-abbrev global-abbrev-table | |
| 132 (downcase name) expansion nil 0)) | |
| 133 | |
| 134 (defun define-mode-abbrev (name expansion) | |
| 135 "Define ABBREV as a mode-specific abbreviation for EXPANSION." | |
| 136 (interactive "sDefine mode abbrev: \nsExpansion for %s: ") | |
| 137 (define-abbrev (or local-abbrev-table | |
| 138 (error "Major mode has no abbrev table")) | |
| 139 (downcase name) expansion nil 0)) | |
| 140 | |
| 141 (defun abbrev-symbol (abbrev &optional table) | |
| 142 "Return the symbol representing abbrev named ABBREV. | |
| 143 This symbol's name is ABBREV, but it is not the canonical symbol of that name; | |
| 144 it is interned in an abbrev-table rather than the normal obarray. | |
| 145 The value is nil if that abbrev is not defined. | |
| 146 Optional second arg TABLE is abbrev table to look it up in. | |
| 147 The default is to try buffer's mode-specific abbrev table, then global table." | |
| 148 (let ((frob (function (lambda (table) | |
| 149 (let ((sym (intern-soft abbrev table))) | |
| 150 (if (and (boundp sym) | |
| 151 (stringp (symbol-value sym))) | |
| 152 sym | |
| 153 nil)))))) | |
| 154 (if table | |
| 155 (funcall frob table) | |
| 156 (or (and local-abbrev-table | |
| 157 (funcall frob local-abbrev-table)) | |
| 158 (funcall frob global-abbrev-table))))) | |
| 159 | |
| 160 (defun abbrev-expansion (abbrev &optional table) | |
| 161 "Return the string that ABBREV expands into in the current buffer. | |
| 162 Optionally specify an abbrev table as second arg; | |
| 163 then ABBREV is looked up in that table only." | |
| 164 (let ((sym (abbrev-symbol abbrev table))) | |
| 165 (if sym | |
| 166 (symbol-value sym) | |
| 167 nil))) | |
| 168 | |
| 169 (defun unexpand-abbrev () | |
| 170 "Undo the expansion of the last abbrev that expanded. | |
| 171 This differs from ordinary undo in that other editing done since then | |
| 172 is not undone." | |
| 173 (interactive) | |
| 174 (if (or (< last-abbrev-location (point-min)) | |
| 175 (> last-abbrev-location (point-max)) | |
| 176 (not (stringp last-abbrev-text))) | |
| 177 nil | |
| 178 (let* ((opoint (point)) | |
| 179 (val (symbol-value last-abbrev)) | |
| 180 (adjust (length val))) | |
| 181 ;; This isn't correct if (symbol-function last-abbrev-text) | |
| 182 ;; was used to do the expansion | |
| 183 (goto-char last-abbrev-location) | |
| 184 (delete-region last-abbrev-location (+ last-abbrev-location adjust)) | |
| 185 (insert last-abbrev-text) | |
| 186 (setq adjust (- adjust (length last-abbrev-text))) | |
| 187 (setq last-abbrev-text nil) | |
| 188 (if (< last-abbrev-location opoint) | |
| 189 (goto-char (- opoint adjust)) | |
| 190 (goto-char opoint))))) | |
| 191 | |
| 192 | |
| 3965 | 193 ; APA: Moved to c (ported function from GNU Emacs to src/abbrev.c) |
| 194 ; (defun insert-abbrev-table-description (name &optional human-readable) | |
| 195 ; "Insert before point a full description of abbrev table named NAME. | |
| 196 ; NAME is a symbol whose value is an abbrev table. | |
| 197 ; If optional second argument HUMAN-READABLE is non-nil, insert a | |
| 198 ; human-readable description. Otherwise the description is an | |
| 199 ; expression, a call to `define-abbrev-table', which would define the | |
| 200 ; abbrev table NAME exactly as it is currently defined." | |
| 201 ; (let ((table (symbol-value name)) | |
| 202 ; (stream (current-buffer))) | |
| 203 ; (message "Abbrev-table %s..." name) | |
| 204 ; (if human-readable | |
| 205 ; (progn | |
| 206 ; (prin1 (list name) stream) | |
| 207 ; ;; Need two terpri's or cretinous edit-abbrevs blows out | |
| 208 ; (terpri stream) | |
| 209 ; (terpri stream) | |
| 210 ; (mapatoms (function (lambda (sym) | |
| 211 ; (if (symbol-value sym) | |
| 212 ; (let* ((n (prin1-to-string (symbol-name sym))) | |
| 213 ; (pos (length n))) | |
| 214 ; (princ n stream) | |
| 215 ; (while (< pos 14) | |
| 216 ; (write-char ?\ stream) | |
| 217 ; (setq pos (1+ pos))) | |
| 218 ; (princ (format " %-5S " (symbol-plist sym)) | |
| 219 ; stream) | |
| 220 ; (if (not (symbol-function sym)) | |
| 221 ; (prin1 (symbol-value sym) stream) | |
| 222 ; (progn | |
| 223 ; (setq n (prin1-to-string (symbol-value sym)) | |
| 224 ; pos (+ pos 6 (length n))) | |
| 225 ; (princ n stream) | |
| 226 ; (while (< pos 45) | |
| 227 ; (write-char ?\ stream) | |
| 228 ; (setq pos (1+ pos))) | |
| 229 ; (prin1 (symbol-function sym) stream))) | |
| 230 ; (terpri stream))))) | |
| 231 ; table) | |
| 232 ; (terpri stream)) | |
| 233 ; (progn | |
| 234 ; (princ "\(define-abbrev-table '" stream) | |
| 235 ; (prin1 name stream) | |
| 236 ; (princ " '\(\n" stream) | |
| 237 ; (mapatoms (function (lambda (sym) | |
| 238 ; (if (symbol-value sym) | |
| 239 ; (progn | |
| 240 ; (princ " " stream) | |
| 241 ; (prin1 (list (symbol-name sym) | |
| 242 ; (symbol-value sym) | |
| 243 ; (symbol-function sym) | |
| 244 ; (symbol-plist sym)) | |
| 245 ; stream) | |
| 246 ; (terpri stream))))) | |
| 247 ; table) | |
| 248 ; (princ " \)\)\n" stream))) | |
| 249 ; (terpri stream)) | |
| 250 ; (message "")) | |
| 428 | 251 ;;; End code not in FSF |
| 252 | |
| 253 (defun abbrev-mode (arg) | |
| 254 "Toggle abbrev mode. | |
| 444 | 255 With argument ARG, enable abbrev mode if ARG is positive, else disable. |
| 428 | 256 In abbrev mode, inserting an abbreviation causes it to expand |
| 257 and be replaced by its expansion." | |
| 258 (interactive "P") | |
| 259 (setq abbrev-mode | |
| 260 (if (null arg) (not abbrev-mode) | |
| 261 (> (prefix-numeric-value arg) 0))) | |
| 262 ;; XEmacs change | |
| 263 (redraw-modeline)) | |
| 264 | |
| 814 | 265 ;; XEmacs change |
| 266 (defun global-abbrev-mode (arg) | |
| 267 "Toggle abbrev mode in all buffers. | |
| 268 With argument ARG, enable abbrev mode globally if ARG is positive, else | |
| 269 disable. In abbrev mode, inserting an abbreviation causes it to expand | |
| 270 and be replaced by its expansion." | |
| 271 (interactive "P") | |
| 272 (let ((newval (if (null arg) (not abbrev-mode) | |
| 273 (> (prefix-numeric-value arg) 0)))) | |
| 274 (setq-default abbrev-mode newval) | |
| 275 (loop for buf being the buffers do | |
| 276 (if (not (eq (symbol-value-in-buffer 'abbrev-mode buf) newval)) | |
| 277 (with-current-buffer buf | |
| 278 (setq abbrev-mode newval))))) | |
| 279 (redraw-modeline)) | |
| 280 | |
| 428 | 281 |
| 282 (defvar edit-abbrevs-map nil | |
| 283 "Keymap used in edit-abbrevs.") | |
| 284 (if edit-abbrevs-map | |
| 285 nil | |
| 286 (setq edit-abbrevs-map (make-sparse-keymap)) | |
| 287 ;; XEmacs change | |
| 288 (set-keymap-name edit-abbrevs-map 'edit-abbrevs-map) | |
| 289 (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine) | |
| 290 (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine)) | |
| 291 | |
| 292 (defun kill-all-abbrevs () | |
| 293 "Undefine all defined abbrevs." | |
| 294 (interactive) | |
| 295 (let ((tables abbrev-table-name-list)) | |
| 296 (while tables | |
| 297 (clear-abbrev-table (symbol-value (car tables))) | |
| 298 (setq tables (cdr tables))))) | |
| 299 | |
| 300 (defun insert-abbrevs () | |
| 301 "Insert after point a description of all defined abbrevs. | |
| 302 Mark is set after the inserted text." | |
| 303 (interactive) | |
| 304 (push-mark | |
| 305 (save-excursion | |
| 306 (let ((tables abbrev-table-name-list)) | |
| 307 (while tables | |
| 308 (insert-abbrev-table-description (car tables) t) | |
| 309 (setq tables (cdr tables)))) | |
| 310 (point)))) | |
| 311 | |
| 312 (defun list-abbrevs () | |
| 313 "Display a list of all defined abbrevs." | |
| 314 (interactive) | |
| 315 (display-buffer (prepare-abbrev-list-buffer))) | |
| 316 | |
| 317 (defun prepare-abbrev-list-buffer () | |
| 318 (save-excursion | |
| 319 (set-buffer (get-buffer-create "*Abbrevs*")) | |
| 320 (erase-buffer) | |
| 321 (let ((tables abbrev-table-name-list)) | |
| 322 (while tables | |
| 323 (insert-abbrev-table-description (car tables) t) | |
| 324 (setq tables (cdr tables)))) | |
| 325 (goto-char (point-min)) | |
| 326 (set-buffer-modified-p nil) | |
| 327 (edit-abbrevs-mode)) | |
| 328 (get-buffer-create "*Abbrevs*")) | |
| 329 | |
| 330 (defun edit-abbrevs-mode () | |
| 331 "Major mode for editing the list of abbrev definitions. | |
| 332 \\{edit-abbrevs-map}" | |
| 333 (interactive) | |
| 334 (setq major-mode 'edit-abbrevs-mode) | |
| 335 (setq mode-name "Edit-Abbrevs") | |
| 336 (use-local-map edit-abbrevs-map)) | |
| 337 | |
| 338 (defun edit-abbrevs () | |
| 339 "Alter abbrev definitions by editing a list of them. | |
| 340 Selects a buffer containing a list of abbrev definitions. | |
| 341 You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs | |
| 342 according to your editing. | |
| 343 Buffer contains a header line for each abbrev table, | |
| 344 which is the abbrev table name in parentheses. | |
| 345 This is followed by one line per abbrev in that table: | |
| 346 NAME USECOUNT EXPANSION HOOK | |
| 347 where NAME and EXPANSION are strings with quotes, | |
| 348 USECOUNT is an integer, and HOOK is any valid function | |
| 349 or may be omitted (it is usually omitted)." | |
| 350 (interactive) | |
| 351 (switch-to-buffer (prepare-abbrev-list-buffer))) | |
| 352 | |
| 353 (defun edit-abbrevs-redefine () | |
| 354 "Redefine abbrevs according to current buffer contents." | |
| 355 (interactive) | |
| 356 (define-abbrevs t) | |
| 357 (set-buffer-modified-p nil)) | |
| 358 | |
| 359 (defun define-abbrevs (&optional arg) | |
| 360 "Define abbrevs according to current visible buffer contents. | |
| 361 See documentation of `edit-abbrevs' for info on the format of the | |
| 362 text you must have in the buffer. | |
| 363 With argument, eliminate all abbrev definitions except | |
| 364 the ones defined from the buffer now." | |
| 365 (interactive "P") | |
| 366 (if arg (kill-all-abbrevs)) | |
| 367 (save-excursion | |
| 368 (goto-char (point-min)) | |
| 369 (while (and (not (eobp)) (re-search-forward "^(" nil t)) | |
| 370 (let* ((buf (current-buffer)) | |
| 371 (table (read buf)) | |
| 372 abbrevs name hook exp count) | |
| 373 (forward-line 1) | |
| 374 (while (progn (forward-line 1) | |
| 375 (not (eolp))) | |
| 376 (setq name (read buf) count (read buf) exp (read buf)) | |
| 377 (skip-chars-backward " \t\n\f") | |
| 378 (setq hook (if (not (eolp)) (read buf))) | |
| 379 (skip-chars-backward " \t\n\f") | |
| 380 (setq abbrevs (cons (list name exp hook count) abbrevs))) | |
| 381 (define-abbrev-table table abbrevs))))) | |
| 382 | |
| 383 (defun read-abbrev-file (&optional file quietly) | |
| 384 "Read abbrev definitions from file written with `write-abbrev-file'. | |
| 385 Optional argument FILE is the name of the file to read; | |
| 386 it defaults to the value of `abbrev-file-name'. | |
| 387 Optional second argument QUIETLY non-nil means don't print anything." | |
| 388 (interactive "fRead abbrev file: ") | |
| 389 (load (if (and file (> (length file) 0)) file abbrev-file-name) | |
| 390 nil quietly) | |
| 391 (setq save-abbrevs t abbrevs-changed nil)) | |
| 392 | |
| 393 (defun quietly-read-abbrev-file (&optional file) | |
| 444 | 394 "Read abbrev definitions from file written with `write-abbrev-file'. |
| 428 | 395 Optional argument FILE is the name of the file to read; |
| 396 it defaults to the value of `abbrev-file-name'. | |
| 397 Does not print anything." | |
| 398 ;(interactive "fRead abbrev file: ") | |
| 399 (read-abbrev-file file t)) | |
| 400 | |
| 401 (defun write-abbrev-file (file) | |
| 402 "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
|
403 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
|
404 listed in listed in `abbrev-table-name-list'. |
| 428 | 405 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
|
406 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
|
407 specified in `abbrev-file-name' is used." |
| 428 | 408 (interactive |
| 409 (list | |
| 410 (read-file-name "Write abbrev file: " | |
| 411 (file-name-directory (expand-file-name abbrev-file-name)) | |
| 412 abbrev-file-name))) | |
| 413 (or (and file (> (length file) 0)) | |
| 414 (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
|
415 (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
|
416 (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
|
417 ;; 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
|
418 ;; 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
|
419 ;; 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
|
420 (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
|
421 (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
|
422 (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
|
423 (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
|
424 ;; 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
|
425 ;; 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
|
426 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
|
427 (insert-abbrev-table-description table nil))))) |
| 428 | 428 |
| 442 | 429 (defun abbrev-string-to-be-defined (arg) |
| 430 "Return the string for which an abbrev will be defined. | |
| 431 ARG is the argument to `add-global-abbrev' or `add-mode-abbrev'." | |
| 432 (if (and (not arg) (region-active-p)) (setq arg 0) | |
| 433 (setq arg (prefix-numeric-value arg))) | |
| 434 (and (>= arg 0) | |
| 435 (buffer-substring | |
| 436 (point) | |
| 437 (if (= arg 0) (mark) | |
| 446 | 438 (save-excursion (backward-word arg) (point)))))) |
| 442 | 439 |
| 428 | 440 (defun add-mode-abbrev (arg) |
| 814 | 441 "Define mode-specific abbrev for region or last word(s) before point. |
| 442 If region active, use it as the expansion\; otherwise, choose the word | |
| 443 before point. A prefix argument specifies the number of words before point | |
| 444 that form the expansion; or zero means the text between point and mark is | |
| 445 the expansion. A negative argument means to undefine the specified abbrev. | |
| 446 This command uses the minibuffer to read the abbreviation. | |
| 428 | 447 |
| 448 Don't use this function in a Lisp program; use `define-abbrev' instead." | |
| 449 ;; XEmacs change: | |
| 450 (interactive "P") | |
| 451 (add-abbrev | |
| 452 (if only-global-abbrevs | |
| 453 global-abbrev-table | |
| 454 (or local-abbrev-table | |
| 455 (error "No per-mode abbrev table"))) | |
| 814 | 456 "Mode" arg) |
| 457 (if defining-abbrev-turns-on-abbrev-mode (abbrev-mode 1))) | |
| 428 | 458 |
| 459 (defun add-global-abbrev (arg) | |
| 814 | 460 "Define global (all modes) 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. | |
| 428 | 465 This command uses the minibuffer to read the abbreviation. |
| 466 | |
| 467 Don't use this function in a Lisp program; use `define-abbrev' instead." | |
| 468 ;; XEmacs change: | |
| 469 (interactive "P") | |
| 814 | 470 (add-abbrev global-abbrev-table "Global" arg) |
| 471 (if defining-abbrev-turns-on-abbrev-mode (global-abbrev-mode 1))) | |
| 428 | 472 |
| 473 (defun add-abbrev (table type arg) | |
| 444 | 474 "Add an abbreviation to abbrev table TABLE. |
| 475 TYPE is a string describing in English the kind of abbrev this will be | |
| 476 (typically, \"global\" or \"mode-specific\"); this is used in | |
| 477 prompting the user. ARG is the number of words in the expansion. | |
| 478 | |
| 479 Return the symbol that internally represents the new abbrev, or nil if | |
| 480 the user declines to confirm redefining an existing abbrev." | |
| 428 | 481 ;; XEmacs change: |
| 442 | 482 (let ((exp (abbrev-string-to-be-defined arg)) |
| 428 | 483 name) |
| 484 (setq name | |
| 485 (read-string (format (if exp "%s abbrev for \"%s\": " | |
| 486 "Undefine %s abbrev: ") | |
| 487 type exp))) | |
| 488 (set-text-properties 0 (length name) nil name) | |
| 489 (if (or (null exp) | |
| 490 (not (abbrev-expansion name table)) | |
| 491 (y-or-n-p (format "%s expands to \"%s\"; redefine? " | |
| 492 name (abbrev-expansion name table)))) | |
| 493 (define-abbrev table (downcase name) exp)))) | |
| 494 | |
| 442 | 495 (defun inverse-abbrev-string-to-be-defined (arg) |
| 496 "Return the string for which an inverse abbrev will be defined. | |
| 497 ARG is the argument to `inverse-add-global-abbrev' or | |
| 498 `inverse-add-mode-abbrev'." | |
| 499 (save-excursion | |
| 446 | 500 (backward-word arg) |
| 442 | 501 (buffer-substring (point) (progn (forward-word 1) (point))))) |
| 502 | |
| 428 | 503 (defun inverse-add-mode-abbrev (arg) |
| 504 "Define last word before point as a mode-specific abbrev. | |
| 505 With prefix argument N, defines the Nth word before point. | |
| 506 This command uses the minibuffer to read the expansion. | |
| 507 Expands the abbreviation after defining it." | |
| 508 (interactive "p") | |
| 509 (inverse-add-abbrev | |
| 510 (if only-global-abbrevs | |
| 511 global-abbrev-table | |
| 512 (or local-abbrev-table | |
| 513 (error "No per-mode abbrev table"))) | |
| 814 | 514 "Mode" arg) |
| 515 (if defining-abbrev-turns-on-abbrev-mode (abbrev-mode 1))) | |
| 428 | 516 |
| 517 (defun inverse-add-global-abbrev (arg) | |
| 518 "Define last word before point as a global (mode-independent) abbrev. | |
| 519 With prefix argument N, defines the Nth word before point. | |
| 520 This command uses the minibuffer to read the expansion. | |
| 521 Expands the abbreviation after defining it." | |
| 522 (interactive "p") | |
| 814 | 523 (inverse-add-abbrev global-abbrev-table "Global" arg) |
| 524 (if defining-abbrev-turns-on-abbrev-mode (global-abbrev-mode 1))) | |
| 428 | 525 |
| 526 (defun inverse-add-abbrev (table type arg) | |
| 527 (let (name nameloc exp) | |
| 528 (save-excursion | |
| 446 | 529 (backward-word arg) |
| 428 | 530 (setq name (buffer-substring (point) (progn (forward-word 1) |
| 531 (setq nameloc (point)))))) | |
| 532 (set-text-properties 0 (length name) nil name) | |
| 533 (setq exp (read-string (format "%s expansion for \"%s\": " | |
| 534 type name))) | |
| 535 (if (or (not (abbrev-expansion name table)) | |
| 536 (y-or-n-p (format "%s expands to \"%s\"; redefine? " | |
| 537 name (abbrev-expansion name table)))) | |
| 538 (progn | |
| 539 (define-abbrev table (downcase name) exp) | |
| 540 (save-excursion | |
| 541 (goto-char nameloc) | |
| 542 (expand-abbrev)))))) | |
| 543 | |
| 544 (defun abbrev-prefix-mark (&optional arg) | |
| 545 "Mark current point as the beginning of an abbrev. | |
| 546 Abbrev to be expanded starts here rather than at beginning of word. | |
| 547 This way, you can expand an abbrev with a prefix: insert the prefix, | |
| 548 use this command, then insert the abbrev." | |
| 549 (interactive "P") | |
| 550 (or arg (expand-abbrev)) | |
| 551 (setq abbrev-start-location (point-marker) | |
| 552 abbrev-start-location-buffer (current-buffer)) | |
| 553 (let ((e (make-extent (point) (point)))) | |
| 554 (set-extent-begin-glyph e (make-glyph [string :data "-"])))) | |
| 555 | |
| 556 (defun expand-region-abbrevs (start end &optional noquery) | |
| 557 "For abbrev occurrence in the region, offer to expand it. | |
| 558 The user is asked to type y or n for each occurrence. | |
| 559 A prefix argument means don't query; expand all abbrevs. | |
| 560 If called from a Lisp program, arguments are START END &optional NOQUERY." | |
| 561 (interactive "r\nP") | |
| 562 (save-excursion | |
| 563 (goto-char start) | |
| 564 (let ((lim (- (point-max) end)) | |
| 565 pnt string) | |
| 566 (while (and (not (eobp)) | |
| 567 (progn (forward-word 1) | |
| 568 (<= (setq pnt (point)) (- (point-max) lim)))) | |
| 569 (if (abbrev-expansion | |
| 570 (setq string | |
| 4009 | 571 (downcase (buffer-substring |
| 572 (save-excursion (backward-word) (point)) | |
| 573 pnt)))) | |
| 428 | 574 (if (or noquery (y-or-n-p (format "Expand `%s'? " string))) |
| 575 (expand-abbrev))))))) | |
| 576 | |
| 577 ;;; abbrev.el ends here |