lisp/expand.el

   1 ;;; expand.el --- make abbreviations more usable
   2
   3 ;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
   7 ;; Maintainer: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
   8 ;; Keywords: abbrev
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26 ;;
  27 ;; This package defines abbrevs which expand into structured constructs
  28 ;; for certain languages.  The construct is indented for you,
  29 ;; and contains slots for you to fill in other text.
  30
  31 ;; These abbrevs expand only at the end of a line and when not in a comment
  32 ;; or a string.
  33 ;;
  34 ;;   Look at the Sample: section for emacs-lisp, perl and c expand lists.
  35 ;; For example for c-mode, you could declare your abbrev table with :
  36 ;;
  37 ;; (defconst c-expand-list
  38 ;;   '(("if" "if () {\n \n} else {\n \n}" (5 10 21))
  39 ;;     ("ifn" "if () {}" (5 8))
  40 ;;     ("uns" "unsigned ")
  41 ;;     ("for" "for(; ; ) {\n\n}" (5 7 9 13))
  42 ;;     ("switch" "switch () {\n\n}" (9 13))
  43 ;;     ("case" "case :\n\nbreak;\n" (6 8 16))
  44 ;;     ("do" "do {\n\n} while ();" (6 16))
  45 ;;     ("while" "while () {\n\n}" (8 12))
  46 ;;     ("default" "default:\n\nbreak;" 10)
  47 ;;     ("main" "int\nmain(int argc, char * argv[])\n{\n\n}\n" 37))
  48 ;;   "Expansions for C mode")
  49 ;;
  50 ;;   and enter Abbrev mode with the following hook :
  51 ;;
  52 ;; (add-hook 'c-mode-hook
  53 ;;        (lambda ()
  54 ;;          (expand-add-abbrevs c-mode-abbrev-table c-expand-list)
  55 ;;          (abbrev-mode 1)))
  56 ;;
  57 ;;   you can also init some post-process hooks :
  58 ;;
  59 ;; (add-hook 'expand-load-hook
  60 ;;        (lambda ()
  61 ;;          (add-hook 'expand-expand-hook 'indent-according-to-mode)
  62 ;;          (add-hook 'expand-jump-hook 'indent-according-to-mode)))
  63 ;;
  64 ;; Remarks:
  65 ;;
  66 ;;   Many thanks to Heddy Boubaker <boubaker@cenatls.cena.dgac.fr>,
  67 ;;                  Jerome Santini <santini@chambord.univ-orleans.fr>,
  68 ;;                  Jari Aalto <jaalto@tre.tele.nokia.fi>.
  69 ;;
  70 ;;   Please send me a word to give me your feeling about this feature or
  71 ;; to explain me how you use it (your expansions table for example) using
  72 ;; the function expand-submit-report.
  73 ;;; Code:
  74 \f
  75 ;;; Constants:
  76
  77 (defgroup expand nil
  78   "Make abbreviations more usable."
  79   :group 'abbrev)
  80
  81 (defcustom expand-load-hook nil
  82   "Hooks run when `expand.el' is loaded."
  83   :type 'hook
  84   :group 'expand)
  85
  86 (defcustom expand-expand-hook nil
  87   "Hooks run when an abbrev made by `expand-add-abbrevs' is expanded."
  88   :type 'hook
  89   :group 'expand)
  90
  91 (defcustom expand-jump-hook nil
  92   "Hooks run by `expand-jump-to-previous-slot' and `expand-jump-to-next-slot'."
  93   :type 'hook
  94   :group 'expand)
  95
  96 ;;; Samples:
  97
  98 (define-skeleton expand-c-for-skeleton "For loop skeleton"
  99   "Loop var: "
 100   "for(" str _ @ "=0; " str @ "; " str @ ") {" \n
 101   @ _ \n
 102   "}" > \n)
 103
 104 (defconst expand-c-sample-expand-list
 105   '(("if" "if () {\n \n} else {\n \n}" (5 10 21))
 106     ("ifn" "if () {}" (5 8))
 107     ("uns" "unsigned ")
 108     ("for" expand-c-for-skeleton)
 109     ("switch" "switch () {\n\n}" (9 13))
 110     ("case" "case :\n\nbreak;\n" (6 8 16))
 111     ("do" "do {\n\n} while ();" (6 16))
 112     ("while" "while () {\n\n}" (8 12))
 113     ("default" "default:\n\nbreak;" 10)
 114     ("main" "int\nmain(int argc, char * argv[])\n{\n\n}\n" 37))
 115   "Expansions for C mode. See `expand-add-abbrevs'.")
 116
 117 ;; lisp example from Jari Aalto <jaalto@tre.tele.nokia.fi>
 118 (defconst expand-sample-lisp-mode-expand-list
 119   (list
 120    (list
 121     "defu"
 122     (concat
 123      "(defun   ()\n"
 124      "  \"\"\n"
 125      "  (interactive)\n"
 126      "  (let* (\n"
 127      "         )\n"
 128      "    \n"
 129      "    ))")
 130     (list 8 11 16 32 43 59))
 131
 132    (list
 133     "defs"
 134     (concat
 135      "(defsubst   ()\n"
 136      "  \"\"\n"
 137      "  (interactive)\n"
 138      "  )")
 139     (list 11 14 19 23 39))
 140
 141    (list
 142     "defm"
 143     (concat
 144      "(defmacro  ()\n"
 145      "  \"\"\n"
 146      "  `( \n"
 147      "    ))")
 148     (list 11 13 18 25))
 149
 150    (list
 151     "defa"
 152     (concat
 153      "(defadvice   (around   act)\n"
 154      "  \"\"\n"
 155      "  \n"
 156      "  )")
 157     (list 12 22 32 36))
 158
 159     (list
 160      "defc"
 161      "(defconst   nil\n  \"\")\n"
 162      (list 11 13 20))
 163
 164     (list
 165      "defv"
 166      "(defvar   nil\n  \"\")\n"
 167      (list 9 11 18))
 168
 169     (list
 170      "let"
 171      "(let* (\n)\n    "
 172      (list 8 13))
 173
 174      (list
 175      "sav"
 176      "(save-excursion\n \n)"
 177      (list 18))
 178
 179      (list
 180      "aut"
 181      "(autoload ' \"\" t t)\n"
 182      (list 12 14))
 183
 184     )
 185    "Expansions for Lisp mode. See `expand-add-abbrevs'.")
 186
 187 ;; perl example from Jari Aalto <jaalto@tre.tele.nokia.fi>
 188 (defconst expand-sample-perl-mode-expand-list
 189   (list
 190    (list
 191     ;;   This is default perl4 subroutine template
 192     ;;
 193     "sub"
 194     (concat
 195      "#" (make-string 70 ?-) "\n"
 196      "sub   {\n"
 197      "    # DESCRIPTION\n"
 198      "    #   \n"
 199      "    #   \n"
 200      "    # INPUT\n"
 201      "    #   \n"
 202      "    #   \n"
 203      "    # RETURN\n"
 204      "    #   \n"
 205      "\n"
 206      "    local( $f ) = \"$lib.\";\n"   ;; Function name AFTER period
 207      "    local() = @_;\n"              ;; func arguments here
 208      "    \n"
 209      "    \n}\n"
 210      )
 211     (list 77 88 120 146 159 176))
 212
 213    (list
 214     "for"                               ; foreach
 215     (concat
 216      "for (  )\n"
 217      "{\n\n\}"
 218      )
 219     (list 7 12))
 220
 221    (list
 222     "whi"                               ; foreach
 223     (concat
 224      "while (  )\n"
 225      "{\n\n\}"
 226      )
 227     (list 9 15))
 228
 229
 230    ;;   The normal "if" can be used like
 231    ;;   print $F "xxxxxx"  if defined @arr;
 232    ;;
 233    (list
 234     "iff"
 235     (concat
 236      "if (  )\n"
 237      "{\n\n\}"
 238      )
 239     (list 6 12))
 240
 241    (list "loc"  "local( $ );"   (list 9))
 242    (list "my"   "my( $ );"      (list 6))
 243    (list "ope"  "open(,\"\")\t|| die \"$f: Can't open [$]\";" (list 6 8 36))
 244    (list "clo"  "close ;"       7)
 245    (list "def"  "defined  "     (list 9))
 246    (list "und"  "undef ;"       (list 7))
 247
 248    ;;   There is no ending colon, because they can be in statement
 249    ;;    defined $REXP_NOT_NEW && (print "xxxxx" );
 250    ;;
 251    (list "pr"  "print "         7)
 252    (list "pf"  "printf "        8)
 253
 254
 255    (list "gre"  "grep( //, );"  (list 8 11))
 256    (list "pus"  "push( , );"    (list 7 9))
 257    (list "joi"  "join( '', );"  (list 7 11))
 258    (list "rtu"  "return ;"      (list 8))
 259
 260    )
 261   "Expansions for Perl mode. See `expand-add-abbrevs'.")
 262
 263 ;;; Code:
 264
 265 ;;;###autoload
 266 (defun expand-add-abbrevs (table abbrevs)
 267   "Add a list of abbrev to abbrev table TABLE.
 268 ABBREVS is a list of abbrev definitions; each abbrev description entry
 269 has the form (ABBREV EXPANSION ARG).
 270
 271 ABBREV is the abbreviation to replace.
 272
 273 EXPANSION is the replacement string or a function which will make the
 274 expansion.  For example you, could use the DMacros or skeleton packages
 275 to generate such functions.
 276
 277 ARG is an optional argument which can be a number or a list of
 278 numbers.  If ARG is a number, point is placed ARG chars from the
 279 beginning of the expanded text.
 280
 281 If ARG is a list of numbers, point is placed according to the first
 282 member of the list, but you can visit the other specified positions
 283 cyclicaly with the functions `expand-jump-to-previous-slot' and
 284 `expand-jump-to-next-slot'.
 285
 286 If ARG is omitted, point is placed at the end of the expanded text."
 287
 288   (if (null abbrevs)
 289       table
 290     (expand-add-abbrev table (nth 0 (car abbrevs)) (nth 1 (car abbrevs))
 291                        (nth 2 (car abbrevs)))
 292     (expand-add-abbrevs table (cdr abbrevs))))
 293
 294 (defvar expand-list nil "Temporary variable used by the Expand package.")
 295
 296 (defvar expand-pos nil
 297   "If non-nil, stores a vector containing markers to positions defined by the last expansion.
 298 This variable is local to a buffer.")
 299 (make-variable-buffer-local 'expand-pos)
 300
 301 (defvar expand-index 0
 302   "Index of the last marker used in `expand-pos'.
 303 This variable is local to a buffer.")
 304 (make-variable-buffer-local 'expand-index)
 305
 306 (defvar expand-point nil
 307   "End of the expanded region.
 308 This variable is local to a buffer.")
 309 (make-variable-buffer-local 'expand-point)
 310
 311 (defun expand-add-abbrev (table abbrev expansion arg)
 312   "Add one abbreviation and provide the hook to move to the specified positions."
 313   (let* ((string-exp (if (and (symbolp expansion) (fboundp expansion))
 314                          nil
 315                        expansion))
 316          (position   (if (and arg string-exp)
 317                          (if (listp arg)
 318                              (- (length expansion) (1- (car arg)))
 319                            (- (length expansion) (1- arg)))
 320                        0)))
 321     (define-abbrev
 322       table
 323       abbrev
 324       (vector string-exp
 325               position
 326               (if (and (listp arg)
 327                        (not (null arg)))
 328                   (cons (length string-exp) arg)
 329                 nil)
 330               (if (and (symbolp expansion) (fboundp expansion))
 331                   expansion
 332                 nil)
 333               )
 334       'expand-abbrev-hook)))
 335
 336 (put 'expand-abbrev-hook 'no-self-insert t)
 337 ;;;###autoload
 338 (defun expand-abbrev-hook ()
 339   "Abbrev hook used to do the expansion job of expand abbrevs.
 340 See `expand-add-abbrevs'.  Value is non-nil if expansion was done."
 341   ;; Expand only at the end of a line if we are near a word that has
 342   ;; an abbrev built from expand-add-abbrev.
 343   (if (and (eolp)
 344            (not (expand-in-literal)))
 345       (let ((p (point)))
 346         (setq expand-point nil)
 347         ;; don't expand if the preceding char isn't a word constituent
 348         (if (and (eq (char-syntax (preceding-char))
 349                      ?w)
 350                  (expand-do-expansion))
 351             (progn
 352               ;; expand-point tells us if we have inserted the text
 353               ;; ourself or if it is the hook which has done the job.
 354               (if expand-point
 355                   (progn
 356                     (if (vectorp expand-list)
 357                         (expand-build-marks expand-point))
 358                     (indent-region p expand-point nil))
 359                 ;; an outside function can set expand-list to a list of
 360                 ;; markers in reverse order.
 361                 (if (listp expand-list)
 362                     (setq expand-index 0
 363                           expand-pos (expand-list-to-markers expand-list)
 364                           expand-list nil)))
 365               (run-hooks 'expand-expand-hook)
 366               t)
 367           nil))
 368     nil))
 369
 370 (defun expand-do-expansion ()
 371   (delete-backward-char (length last-abbrev-text))
 372   (let* ((vect (symbol-value last-abbrev))
 373          (text (aref vect 0))
 374          (position (aref vect 1))
 375          (jump-args (aref vect 2))
 376          (hook (aref vect 3)))
 377     (cond (text
 378            (insert text)
 379            (setq expand-point (point))))
 380     (if jump-args
 381         (funcall 'expand-build-list (car jump-args) (cdr jump-args)))
 382     (if position
 383         (backward-char position))
 384     (if hook
 385         (funcall hook))
 386     t)
 387   )
 388
 389 (defun expand-abbrev-from-expand (word)
 390   "Test if an abbrev has a hook."
 391   (or
 392    (and (intern-soft word local-abbrev-table)
 393         (symbol-function (intern-soft word local-abbrev-table)))
 394    (and (intern-soft word global-abbrev-table)
 395         (symbol-function (intern-soft word global-abbrev-table)))))
 396
 397 (defun expand-previous-word ()
 398   "Return the previous word."
 399   (save-excursion
 400     (let ((p (point)))
 401       (backward-word 1)
 402       (buffer-substring p (point)))))
 403
 404 ;;;###autoload
 405 (defun expand-jump-to-previous-slot ()
 406   "Move the cursor to the previous slot in the last abbrev expansion.
 407 This is used only in conjunction with `expand-add-abbrevs'."
 408   (interactive)
 409   (if expand-pos
 410       (progn
 411         (setq expand-index (1- expand-index))
 412         (if (< expand-index 0)
 413             (setq expand-index (1- (length expand-pos))))
 414         (goto-char (aref expand-pos expand-index))
 415         (run-hooks 'expand-jump-hook))))
 416
 417 ;;;###autoload
 418 (defun expand-jump-to-next-slot ()
 419   "Move the cursor to the next slot in the last abbrev expansion.
 420 This is used only in conjunction with `expand-add-abbrevs'."
 421   (interactive)
 422   (if expand-pos
 423       (progn
 424         (setq expand-index (1+ expand-index))
 425         (if (>= expand-index (length expand-pos))
 426             (setq expand-index 0))
 427         (goto-char (aref expand-pos expand-index))
 428         (run-hooks 'expand-jump-hook))))
 429
 430 ;;;###autoload (define-key ctl-x-map "ap" 'expand-jump-to-previous-slot)
 431 ;;;###autoload (define-key ctl-x-map "an" 'expand-jump-to-next-slot)
 432
 433 (defun expand-build-list (len l)
 434   "Build a vector of offset positions from the list of positions."
 435   (expand-clear-markers)
 436   (setq expand-list (vconcat l))
 437   (let ((i 0)
 438         (lenlist (length expand-list)))
 439     (while (< i lenlist)
 440       (aset expand-list i (- len (1- (aref expand-list i))))
 441       (setq i (1+ i))))
 442   )
 443
 444 (defun expand-build-marks (p)
 445   "Transform the offsets vector into a marker vector."
 446   (if expand-list
 447       (progn
 448         (setq expand-index 0)
 449         (setq expand-pos (make-vector (length expand-list) nil))
 450         (let ((i (1- (length expand-list))))
 451           (while (>= i 0)
 452             (aset expand-pos i (copy-marker (- p (aref expand-list i))))
 453             (setq i (1- i))))
 454         (setq expand-list nil))))
 455
 456 (defun expand-clear-markers ()
 457   "Make the markers point nowhere."
 458   (if expand-pos
 459       (progn
 460     (let ((i (1- (length expand-pos))))
 461       (while (>= i 0)
 462         (set-marker (aref expand-pos i) nil)
 463         (setq i (1- i))))
 464     (setq expand-pos nil))))
 465
 466 (defun expand-in-literal ()
 467   "Test if we are in a comment or in a string."
 468   (save-excursion
 469     (let* ((lim (or (save-excursion
 470                       (beginning-of-defun)
 471                       (point))
 472                     (point-min)))
 473            (here (point))
 474            (state (parse-partial-sexp lim (point))))
 475       (cond
 476        ((nth 3 state) 'string)
 477        ((nth 4 state) 'comment)
 478        (t nil)))))
 479
 480 ;; support functions to add marks to jump from outside function
 481
 482 (defun expand-list-to-markers (l)
 483   "Transform a list of markers in reverse order into a vector in the correct order."
 484   (let* ((len (1- (length l)))
 485          (loop len)
 486          (v (make-vector (+ len 1) nil)))
 487     (while (>= loop 0)
 488       (aset v loop (if (markerp (car l)) (car l) (copy-marker (car l))))
 489       (setq l (cdr l)
 490             loop (1- loop)))
 491     v))
 492
 493 ;; integration with skeleton.el
 494 ;; Used in `skeleton-end-hook' to fetch the positions for  @ skeleton tags.
 495 ;; See `skeleton-insert'.
 496 (defun expand-skeleton-end-hook ()
 497   (if skeleton-positions
 498       (setq expand-list skeleton-positions)))
 499
 500 (add-hook 'skeleton-end-hook (function expand-skeleton-end-hook))
 501
 502 (provide 'expand)
 503
 504 ;; run load hooks
 505 (run-hooks 'expand-load-hook)
 506
 507 ;; arch-tag: fee53e9e-30e3-4ef3-b191-9785e1f8e885
 508 ;;; expand.el ends here