comparison lisp/modes/abbrev.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 85ec50267440
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;;; abbrev.el --- abbrev mode commands for Emacs 1 ;;; abbrev.el --- abbrev mode commands for Emacs
2 2
3 ;; Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
4 ;; Keywords: internal, abbrev 4
5 ;; Keywords: abbrev
5 6
6 ;; This file is part of XEmacs. 7 ;; This file is part of XEmacs.
7 8
8 ;; XEmacs is free software; you can redistribute it and/or modify it 9 ;; XEmacs is free software; you can redistribute it and/or modify it
9 ;; under the terms of the GNU General Public License as published by 10 ;; under the terms of the GNU General Public License as published by
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;; General Public License for more details. 17 ;; General Public License for more details.
17 18
18 ;; You should have received a copy of the GNU General Public License 19 ;; You should have received a copy of the GNU General Public License
19 ;; along with XEmacs; see the file COPYING. If not, write to the Free 20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
20 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
22 ;; 02111-1307, USA.
23
24 ;;; Synched up with: FSF 19.34 (With some additions)
25
26 ;;; Commentary:
27
28 ;; This facility is documented in the Emacs Manual.
29
30 ;;; Code:
21 31
22 ;jwz: this is preloaded so don't ;;;###autoload 32 ;jwz: this is preloaded so don't ;;;###autoload
23 (defconst only-global-abbrevs nil 33 (defconst only-global-abbrevs nil "\
24 "*t means user plans to use global abbrevs only. 34 *t means user plans to use global abbrevs only.
25 Makes the commands to define mode-specific abbrevs define global ones instead." 35 Makes the commands to define mode-specific abbrevs define global ones instead.")
26 ) 36
27 37 ;;; XEmacs: the following block of code is not in FSF
28 (defvar abbrev-table-name-list '() 38 (defvar abbrev-table-name-list '()
29 "List of symbols whose values are abbrev tables.") 39 "List of symbols whose values are abbrev tables.")
30 40
31 (defvar abbrevs-changed nil 41 (defvar abbrevs-changed nil
32 "Set non-nil by defining or altering any word abbrevs. 42 "Set non-nil by defining or altering any word abbrevs.
232 (terpri stream))))) 242 (terpri stream)))))
233 table) 243 table)
234 (princ " \)\)\n" stream))) 244 (princ " \)\)\n" stream)))
235 (terpri stream)) 245 (terpri stream))
236 (message "")) 246 (message ""))
237 247 ;;; End code not in FSF
238 248
239 (defun abbrev-mode (arg) 249 (defun abbrev-mode (arg)
240 "Toggle abbrev mode. 250 "Toggle abbrev mode.
241 With arg, turn abbrev mode on iff arg is positive. 251 With argument ARG, turn abbrev mode on iff ARG is positive.
242 In abbrev mode, inserting an abbreviation causes it to expand 252 In abbrev mode, inserting an abbreviation causes it to expand
243 and be replaced by its expansion." 253 and be replaced by its expansion."
244 (interactive "P") 254 (interactive "P")
245 (setq abbrev-mode 255 (setq abbrev-mode
246 (if (null arg) (not abbrev-mode) 256 (if (null arg) (not abbrev-mode)
247 (> (prefix-numeric-value arg) 0))) 257 (> (prefix-numeric-value arg) 0)))
258 ;; XEmacs change
248 (redraw-modeline)) 259 (redraw-modeline))
249 260
250 261
251 (defvar edit-abbrevs-map nil 262 (defvar edit-abbrevs-map nil
252 "Keymap used in edit-abbrevs.") 263 "Keymap used in edit-abbrevs.")
253 (if edit-abbrevs-map 264 (if edit-abbrevs-map
254 nil 265 nil
255 (setq edit-abbrevs-map (make-sparse-keymap)) 266 (setq edit-abbrevs-map (make-sparse-keymap))
267 ;; XEmacs change
256 (set-keymap-name edit-abbrevs-map 'edit-abbrevs-map) 268 (set-keymap-name edit-abbrevs-map 'edit-abbrevs-map)
257 (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine) 269 (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine)
258 (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine)) 270 (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine))
259 271
260 (defun kill-all-abbrevs () 272 (defun kill-all-abbrevs ()
304 (use-local-map edit-abbrevs-map)) 316 (use-local-map edit-abbrevs-map))
305 317
306 (defun edit-abbrevs () 318 (defun edit-abbrevs ()
307 "Alter abbrev definitions by editing a list of them. 319 "Alter abbrev definitions by editing a list of them.
308 Selects a buffer containing a list of abbrev definitions. 320 Selects a buffer containing a list of abbrev definitions.
309 You can edit them and type C-c C-c to redefine abbrevs 321 You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs
310 according to your editing. 322 according to your editing.
311 Buffer contains a header line for each abbrev table, 323 Buffer contains a header line for each abbrev table,
312 which is the abbrev table name in parentheses. 324 which is the abbrev table name in parentheses.
313 This is followed by one line per abbrev in that table: 325 This is followed by one line per abbrev in that table:
314 NAME USECOUNT EXPANSION HOOK 326 NAME USECOUNT EXPANSION HOOK
324 (define-abbrevs t) 336 (define-abbrevs t)
325 (set-buffer-modified-p nil)) 337 (set-buffer-modified-p nil))
326 338
327 (defun define-abbrevs (&optional arg) 339 (defun define-abbrevs (&optional arg)
328 "Define abbrevs according to current visible buffer contents. 340 "Define abbrevs according to current visible buffer contents.
329 See documentation of edit-abbrevs for info on the format of the 341 See documentation of `edit-abbrevs' for info on the format of the
330 text you must have in the buffer. 342 text you must have in the buffer.
331 With argument, eliminate all abbrev definitions except 343 With argument, eliminate all abbrev definitions except
332 the ones defined from the buffer now." 344 the ones defined from the buffer now."
333 (interactive "P") 345 (interactive "P")
334 (if arg (kill-all-abbrevs)) 346 (if arg (kill-all-abbrevs))
335 (save-excursion 347 (save-excursion
336 (goto-char (point-min)) 348 (goto-char (point-min))
337 (while (and (not (eobp)) (re-search-forward "^(" nil t)) 349 (while (and (not (eobp)) (re-search-forward "^(" nil t))
338 (let* ((buf (current-buffer)) 350 (let* ((buf (current-buffer))
339 (table (read buf)) 351 (table (read buf))
340 (abbrevs '())) 352 abbrevs name hook exp count)
341 (forward-line 1) 353 (forward-line 1)
342 (while (progn (forward-line 1) 354 (while (progn (forward-line 1)
343 (not (eolp))) 355 (not (eolp)))
344 (let* ((name (read buf)) 356 (setq name (read buf) count (read buf) exp (read buf))
345 (count (read buf)) 357 (skip-chars-backward " \t\n\f")
346 (exp (read buf)) 358 (setq hook (if (not (eolp)) (read buf)))
347 hook) 359 (skip-chars-backward " \t\n\f")
348 (skip-chars-backward " \t\n\f") 360 (setq abbrevs (cons (list name exp hook count) abbrevs)))
349 (setq hook (if (not (eolp)) (read buf)))
350 (skip-chars-backward " \t\n\f")
351 (setq abbrevs (cons (list name exp hook count) abbrevs))))
352 (define-abbrev-table table abbrevs))))) 361 (define-abbrev-table table abbrevs)))))
353 362
354 (defun read-abbrev-file (&optional file quietly) 363 (defun read-abbrev-file (&optional file quietly)
355 "Read abbrev definitions from file written with write-abbrev-file. 364 "Read abbrev definitions from file written with `write-abbrev-file'.
356 Takes file name as argument. 365 Optional argument FILE is the name of the file to read;
357 Optional second argument non-nil means don't print anything." 366 it defaults to the value of `abbrev-file-name'.
367 Optional second argument QUIETLY non-nil means don't print anything."
358 (interactive "fRead abbrev file: ") 368 (interactive "fRead abbrev file: ")
359 (load (if (and file (> (length file) 0)) file abbrev-file-name) 369 (load (if (and file (> (length file) 0)) file abbrev-file-name)
360 nil quietly) 370 nil quietly)
361 (setq save-abbrevs t abbrevs-changed nil)) 371 (setq save-abbrevs t abbrevs-changed nil))
362 372
363 (defun quietly-read-abbrev-file (&optional file) 373 (defun quietly-read-abbrev-file (&optional file)
364 "Read abbrev definitions from file written with write-abbrev-file. 374 "Read abbrev definitions from file written with write-abbrev-file.
365 Takes file name as argument. Does not print anything." 375 Optional argument FILE is the name of the file to read;
376 it defaults to the value of `abbrev-file-name'.
377 Does not print anything."
366 ;(interactive "fRead abbrev file: ") 378 ;(interactive "fRead abbrev file: ")
367 (read-abbrev-file file t)) 379 (read-abbrev-file file t))
368 380
369 (defun write-abbrev-file (file) 381 (defun write-abbrev-file (file)
370 "Write all abbrev definitions to file of Lisp code. 382 "Write all abbrev definitions to a file of Lisp code.
371 The file can be loaded to define the same abbrevs." 383 The file written can be loaded in another session to define the same abbrevs.
384 The argument FILE is the file name to write."
372 (interactive 385 (interactive
373 (list 386 (list
374 (read-file-name "Write abbrev file: " 387 (read-file-name "Write abbrev file: "
375 (file-name-directory (expand-file-name abbrev-file-name)) 388 (file-name-directory (expand-file-name abbrev-file-name))
376 abbrev-file-name))) 389 abbrev-file-name)))
385 (setq tables (cdr tables)))) 398 (setq tables (cdr tables))))
386 (write-region 1 (point-max) file) 399 (write-region 1 (point-max) file)
387 (erase-buffer))) 400 (erase-buffer)))
388 401
389 (defun add-mode-abbrev (arg) 402 (defun add-mode-abbrev (arg)
390 "Define mode-specific abbrev for region or last word(s) before point. 403 "Define mode-specific abbrev for last word(s) before point.
391 Argument is how many words before point form the expansion; 404 Argument is how many words before point form the expansion;
392 or zero means the region is the expansion. 405 or zero means the region is the expansion.
393 A negative argument means to undefine the specified abbrev. 406 A negative argument means to undefine the specified abbrev.
394 Reads the abbreviation in the minibuffer. 407 Reads the abbreviation in the minibuffer.
395 408
396 Don't use this function in a Lisp program; use define-abbrev instead." 409 Don't use this function in a Lisp program; use `define-abbrev' instead."
397 ;; XEmacs change: 410 ;; XEmacs change:
398 (interactive "P") 411 (interactive "P")
399 (add-abbrev (if only-global-abbrevs 412 (add-abbrev
400 global-abbrev-table 413 (if only-global-abbrevs
401 (or local-abbrev-table 414 global-abbrev-table
402 (error "No per-mode abbrev table."))) 415 (or local-abbrev-table
403 "Mode" 416 (error "No per-mode abbrev table")))
404 arg)) 417 "Mode" arg))
405 418
406 (defun add-global-abbrev (arg) 419 (defun add-global-abbrev (arg)
407 "Define global (all modes) abbrev for region or last word(s) before point. 420 "Define global (all modes) abbrev for last word(s) before point.
408 Argument is how many words before point form the expansion; 421 The prefix argument specifies the number of words before point that form the
409 or zero means the region is the expansion. 422 expansion; or zero means the region is the expansion.
410 A negative argument means to undefine the specified abbrev. 423 A negative argument means to undefine the specified abbrev.
411 Reads the abbreviation in the minibuffer. 424 This command uses the minibuffer to read the abbreviation.
412 425
413 Don't use this function in a Lisp program; use define-abbrev instead." 426 Don't use this function in a Lisp program; use `define-abbrev' instead."
414 ;; XEmacs change: 427 ;; XEmacs change:
415 (interactive "P") 428 (interactive "P")
416 (add-abbrev global-abbrev-table "Global" arg)) 429 (add-abbrev global-abbrev-table "Global" arg))
417 430
418 (defun add-abbrev (table type arg) 431 (defun add-abbrev (table type arg)
427 name) 440 name)
428 (setq name 441 (setq name
429 (read-string (format (if exp "%s abbrev for \"%s\": " 442 (read-string (format (if exp "%s abbrev for \"%s\": "
430 "Undefine %s abbrev: ") 443 "Undefine %s abbrev: ")
431 type exp))) 444 type exp)))
445 (set-text-properties 0 (length name) nil name)
432 (if (or (null exp) 446 (if (or (null exp)
433 (not (abbrev-expansion name table)) 447 (not (abbrev-expansion name table))
434 (y-or-n-p (format "%s expands to \"%s\"; redefine? " 448 (y-or-n-p (format "%s expands to \"%s\"; redefine? "
435 name (abbrev-expansion name table)))) 449 name (abbrev-expansion name table))))
436 (define-abbrev table (downcase name) exp)))) 450 (define-abbrev table (downcase name) exp))))
437 451
438 (defun inverse-add-mode-abbrev (arg) 452 (defun inverse-add-mode-abbrev (arg)
439 "Define last word before point as a mode-specific abbrev. 453 "Define last word before point as a mode-specific abbrev.
440 With argument N, defines the Nth word before point. 454 With prefix argument N, defines the Nth word before point.
441 Reads the expansion in the minibuffer. 455 This command uses the minibuffer to read the expansion.
442 Expands the abbreviation after defining it." 456 Expands the abbreviation after defining it."
443 (interactive "p") 457 (interactive "p")
444 (inverse-add-abbrev (if only-global-abbrevs 458 (inverse-add-abbrev
445 global-abbrev-table 459 (if only-global-abbrevs
446 (or local-abbrev-table 460 global-abbrev-table
447 (error "No per-mode abbrev table."))) 461 (or local-abbrev-table
448 "Mode" 462 (error "No per-mode abbrev table")))
449 arg)) 463 "Mode" arg))
450 464
451 (defun inverse-add-global-abbrev (arg) 465 (defun inverse-add-global-abbrev (arg)
452 "Define last word before point as a global (mode-independent) abbrev. 466 "Define last word before point as a global (mode-independent) abbrev.
453 With argument N, defines the Nth word before point. 467 With prefix argument N, defines the Nth word before point.
454 Reads the expansion in the minibuffer. 468 This command uses the minibuffer to read the expansion.
455 Expands the abbreviation after defining it." 469 Expands the abbreviation after defining it."
456 (interactive "p") 470 (interactive "p")
457 (inverse-add-abbrev global-abbrev-table "Global" arg)) 471 (inverse-add-abbrev global-abbrev-table "Global" arg))
458 472
459 (defun inverse-add-abbrev (table type arg) 473 (defun inverse-add-abbrev (table type arg)
460 (let (name nameloc exp) 474 (let (name nameloc exp)
461 (save-excursion 475 (save-excursion
462 (forward-word (- arg)) 476 (forward-word (- arg))
463 (setq name (buffer-substring (point) (progn (forward-word 1) 477 (setq name (buffer-substring (point) (progn (forward-word 1)
464 (setq nameloc (point)))))) 478 (setq nameloc (point))))))
479 (set-text-properties 0 (length name) nil name)
465 (setq exp (read-string (format "%s expansion for \"%s\": " 480 (setq exp (read-string (format "%s expansion for \"%s\": "
466 type name))) 481 type name)))
467 (if (or (not (abbrev-expansion name table)) 482 (if (or (not (abbrev-expansion name table))
468 (y-or-n-p (format "%s expands to \"%s\"; redefine? " 483 (y-or-n-p (format "%s expands to \"%s\"; redefine? "
469 name (abbrev-expansion name table)))) 484 name (abbrev-expansion name table))))
473 (goto-char nameloc) 488 (goto-char nameloc)
474 (expand-abbrev)))))) 489 (expand-abbrev))))))
475 490
476 (defun abbrev-prefix-mark (&optional arg) 491 (defun abbrev-prefix-mark (&optional arg)
477 "Mark current point as the beginning of an abbrev. 492 "Mark current point as the beginning of an abbrev.
478 Abbrev to be expanded starts here rather than at 493 Abbrev to be expanded starts here rather than at beginning of word.
479 beginning of word. This way, you can expand an abbrev 494 This way, you can expand an abbrev with a prefix: insert the prefix,
480 with a prefix: insert the prefix, use this command, 495 use this command, then insert the abbrev."
481 then insert the abbrev."
482 (interactive "P") 496 (interactive "P")
483 (or arg (expand-abbrev)) 497 (or arg (expand-abbrev))
484 (setq abbrev-start-location (point-marker) 498 (setq abbrev-start-location (point-marker)
485 abbrev-start-location-buffer (current-buffer)) 499 abbrev-start-location-buffer (current-buffer))
486 (insert "-")) 500 (insert "-"))
487 501
488 (defun expand-region-abbrevs (start end &optional noquery) 502 (defun expand-region-abbrevs (start end &optional noquery)
489 "For abbrev occurrence in the region, offer to expand it. 503 "For abbrev occurrence in the region, offer to expand it.
490 The user is asked to type y or n for each occurrence. 504 The user is asked to type y or n for each occurrence.
491 A numeric argument means don't query; expand all abbrevs. 505 A prefix argument means don't query; expand all abbrevs.
492 Calling from a program, arguments are START END &optional NOQUERY." 506 If called from a Lisp program, arguments are START END &optional NOQUERY."
493 (interactive "r\nP") 507 (interactive "r\nP")
494 (save-excursion 508 (save-excursion
495 (goto-char start) 509 (goto-char start)
496 (let ((lim (- (point-max) end)) 510 (let ((lim (- (point-max) end))
497 pnt string) 511 pnt string)
503 (buffer-substring 517 (buffer-substring
504 (save-excursion (forward-word -1) (point)) 518 (save-excursion (forward-word -1) (point))
505 pnt))) 519 pnt)))
506 (if (or noquery (y-or-n-p (format "Expand `%s'? " string))) 520 (if (or noquery (y-or-n-p (format "Expand `%s'? " string)))
507 (expand-abbrev))))))) 521 (expand-abbrev)))))))
522
523 ;;; abbrev.el ends here