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