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