code.delx.au - gnu-emacs-elpa/blob - yasnippet.el

   1 ;;; yasnippet.el --- Yet another snippet extension for Emacs.
   2
   3 ;; Author: pluskid <pluskid@gmail.com>
   4 ;; Version: 0.1
   5
   6 ;; This file is free software; you can redistribute it and/or modify
   7 ;; it under the terms of the GNU General Public License as published by
   8 ;; the Free Software Foundation; either version 2, or (at your option)
   9 ;; any later version.
  10
  11 ;; This file is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;; GNU General Public License for more details.
  15
  16 ;; You should have received a copy of the GNU General Public License
  17 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 ;; Boston, MA 02111-1307, USA.
  20
  21 ;;; Commentary:
  22
  23 ;; Nothing.
  24
  25 (require 'cl)
  26
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;; User customizable variables
  29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30 (defvar yas/key-syntax "w"
  31   "Syntax of a key. This is used to determine the current key being
  32 expanded.")
  33
  34 (defvar yas/indent-line t
  35   "Each (except the 1st) line of the snippet template is indented to
  36 current column if this variable is non-`nil'.")
  37 (make-variable-buffer-local 'yas/indent-line)
  38
  39 (defvar yas/keymap (make-sparse-keymap)
  40   "The keymap of snippet.")
  41 (define-key yas/keymap (kbd "TAB") 'yas/next-field-group)
  42 (define-key yas/keymap (kbd "S-TAB") 'yas/prev-field-group)
  43 (define-key yas/keymap (kbd "<S-iso-lefttab>") 'yas/prev-field-group)
  44 (define-key yas/keymap (kbd "<S-tab>") 'yas/prev-field-group)
  45
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47 ;; Internal variables
  48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  49 (defvar yas/snippet-tables (make-hash-table)
  50   "A hash table of snippet tables corresponding to each major-mode.")
  51
  52 (defconst yas/escape-backslash
  53   (concat "YASESCAPE" "BACKSLASH" "PROTECTGUARD"))
  54 (defconst yas/escape-dollar
  55   (concat "YASESCAPE" "DOLLAR" "PROTECTGUARD"))
  56 (defconst yas/escape-backquote
  57   (concat "YASESCAPE" "BACKQUOTE" "PROTECTGUARD"))
  58
  59 (defconst yas/field-regexp
  60   (concat "$\\(?1:[0-9]+\\)" "\\|"
  61           "${\\(?:\\(?1:[0-9]+\\):\\)?\\(?2:[^}]*\\)}"))
  62
  63 (defvar yas/snippet-id-seed 0
  64   "Contains the next id for a snippet")
  65 (defun yas/snippet-next-id ()
  66   (let ((id yas/snippet-id-seed))
  67     (incf yas/snippet-id-seed)
  68     id))
  69
  70 (defvar yas/overlay-modification-hooks
  71   (list 'yas/overlay-modification-hook)
  72   "The list of hooks to the overlay modification event.")
  73 (defvar yas/overlay-insert-in-front-hooks
  74   (list 'yas/overlay-insert-in-front-hook)
  75   "The list of hooks of the overlay inserted in front event.")
  76 (defvar yas/overlay-insert-behind-hooks
  77   (list 'yas/overlay-insert-behind-hook)
  78   "The list of hooks of the overlay inserted behind event.")
  79
  80
  81 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  82 ;; Internal Structs
  83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84 (defstruct (yas/snippet (:constructor yas/make-snippet ()))
  85   "A snippet."
  86   (groups nil)
  87   (exit-marker nil)
  88   (id (yas/snippet-next-id) :read-only t))
  89 (defstruct (yas/group (:constructor yas/make-group (primary-field snippet)))
  90   "A group contains a list of field with the same number."
  91   primary-field
  92   (fields (list primary-field))
  93   (next nil)
  94   (prev nil)
  95   (keymap-overlay nil)
  96   snippet)
  97 (defstruct (yas/field (:constructor yas/make-field (overlay number value)))
  98   "A field in a snippet."
  99   overlay
 100   number
 101   value)
 102
 103 (defun yas/snippet-add-field (snippet field)
 104   "Add FIELD to SNIPPET."
 105   (let ((group (find field
 106                      (yas/snippet-groups snippet)
 107                      :test
 108                      '(lambda (field group)
 109                         (= (yas/field-number field)
 110                            (yas/group-number group))))))
 111     (if group
 112         (yas/group-add-field group field)
 113       (push (yas/make-group field snippet)
 114             (yas/snippet-groups snippet)))))
 115
 116 (defun yas/group-value (group)
 117   "Get the default value of the field group."
 118   (or (yas/field-value
 119        (yas/group-primary-field group))
 120       "(no default value)"))
 121 (defun yas/group-number (group)
 122   "Get the number of the field group."
 123   (yas/field-number
 124    (yas/group-primary-field group)))
 125 (defun yas/group-add-field (group field)
 126   "Add a field to the field group. If the value of the primary
 127 field is nil and that of the field is not nil, the field is set
 128 as the primary field of the group."
 129   (push field (yas/group-fields group))
 130   (when (and (null (yas/field-value (yas/group-primary-field group)))
 131              (yas/field-value field))
 132     (setf (yas/group-primary-field group) field)))
 133
 134 (defun yas/snippet-field-compare (field1 field2)
 135   "Compare two fields. The field with a number is sorted first.
 136 If they both have a number, compare through the number. If neither
 137 have, compare through the start point of the overlay."
 138   (let ((n1 (yas/field-number field1))
 139         (n2 (yas/field-number field2)))
 140     (if n1
 141         (if n2
 142             (< n1 n2)
 143           t)
 144       (if n2
 145           nil
 146         (< (overlay-start (yas/field-overlay field1))
 147            (overlay-start (yas/field-overlay field2)))))))
 148
 149 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 150 ;; Internal functions
 151 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 152 (defun yas/eval-string (string)
 153   "Evaluate STRING and convert the result to string."
 154   (condition-case err
 155       (format "%s" (eval (read string)))
 156     (error (format "(error in elisp evaluation: %s)"
 157                    (error-message-string err)))))
 158 (defsubst yas/replace-all (from to)
 159   "Replace all occurance from FROM to TO."
 160   (goto-char (point-min))
 161   (while (search-forward from nil t)
 162     (replace-match to t t)))
 163 (defun yas/snippet-table (mode)
 164   "Get the snippet table corresponding to MODE."
 165   (let ((table (gethash mode yas/snippet-tables)))
 166     (unless table
 167       (setq table (make-hash-table :test 'equal))
 168       (puthash mode table yas/snippet-tables))
 169     table))
 170 (defsubst yas/current-snippet-table ()
 171   "Get the snippet table for current major-mode."
 172   (yas/snippet-table major-mode))
 173
 174 (defsubst yas/template (key snippet-table)
 175   "Get template for KEY in SNIPPET-TABLE."
 176   (gethash key snippet-table))
 177
 178 (defun yas/current-key ()
 179   "Get the key under current position. A key is used to find
 180 the template of a snippet in the current snippet-table."
 181   (let ((start (point))
 182         (end (point)))
 183     (save-excursion
 184       (skip-syntax-backward yas/key-syntax)
 185       (setq start (point))
 186       (list (buffer-substring-no-properties start end)
 187             start
 188             end))))
 189
 190 (defun yas/synchronize-fields (field-group)
 191   "Update all fields' text according to the primary field."
 192   (save-excursion
 193     (let* ((inhibit-modification-hooks t)
 194            (primary (yas/group-primary-field field-group))
 195            (primary-overlay (yas/field-overlay primary))
 196            (text (buffer-substring-no-properties (overlay-start primary-overlay)
 197                                                  (overlay-end primary-overlay))))
 198       (dolist (field (yas/group-fields field-group))
 199         (let* ((field-overlay (yas/field-overlay field))
 200                (original-length (- (overlay-end field-overlay)
 201                                    (overlay-start field-overlay))))
 202           (unless (eq field-overlay primary-overlay)
 203             (goto-char (overlay-start field-overlay))
 204             (insert text)
 205             (delete-char original-length)))))))
 206
 207 (defun yas/overlay-modification-hook (overlay after? beg end &optional length)
 208   "Modification hook for snippet field overlay."
 209   (when (and after? (not undo-in-progress))
 210     (yas/synchronize-fields (overlay-get overlay 'yas/group))))
 211 (defun yas/overlay-insert-in-front-hook (overlay after? beg end &optional length)
 212   "Hook for snippet overlay when text is inserted in front of a snippet field."
 213   (when after?
 214     (let ((field-group (overlay-get overlay 'yas/group))
 215           (inhibit-modification-hooks t))
 216       (when (not (overlay-get overlay 'yas/modified?))
 217         (overlay-put overlay 'yas/modified? t)
 218         (save-excursion
 219           (goto-char end)
 220           (delete-char (- (overlay-end overlay) end))))
 221      (yas/synchronize-fields field-group))))
 222 (defun yas/overlay-insert-behind-hook (overlay after? beg end &optional length)
 223   "Hook for snippet overlay when text is inserted just behind a snippet field."
 224   (when (and after?
 225              (null (yas/current-snippet-overlay beg))) ; not inside another field
 226     (move-overlay overlay
 227                   (overlay-start overlay)
 228                   end)
 229     (yas/synchronize-fields (overlay-get overlay 'yas/group))))
 230
 231 (defun yas/undo-expand-snippet (start end key snippet)
 232   "Undo a snippet expansion. Delete the overlays. This undo can't be
 233 redo-ed."
 234   (let ((undo (car buffer-undo-list)))
 235     (while (null undo)
 236       (setq buffer-undo-list (cdr buffer-undo-list))
 237       (setq undo (car buffer-undo-list)))
 238     ;; Remove this undo operation record
 239     (setq buffer-undo-list (cdr buffer-undo-list))
 240   (let ((inhibit-modification-hooks t)
 241         (buffer-undo-list t))
 242     (yas/exit-snippet snippet)
 243     (goto-char start)
 244     (delete-char (- end start))
 245     (insert key))))
 246
 247 (defun yas/expand-snippet (start end template)
 248   "Expand snippet at current point. Text between START and END
 249 will be deleted before inserting template."
 250   (goto-char start)
 251
 252   (let ((key (buffer-substring-no-properties start end))
 253         (original-undo-list buffer-undo-list)
 254         (inhibit-modification-hooks t)
 255         (length (- end start))
 256         (column (current-column)))
 257     (save-restriction
 258       (narrow-to-region start start)
 259
 260       (setq buffer-undo-list t)
 261       (insert template)
 262
 263       ;; Step 1: do necessary indent
 264       (when yas/indent-line
 265         (let* ((indent (if indent-tabs-mode
 266                            (concat (make-string (/ column tab-width) ?\t)
 267                                    (make-string (% column tab-width) ?\ ))
 268                          (make-string column ?\ ))))
 269           (goto-char (point-min))
 270           (while (and (zerop (forward-line))
 271                       (= (current-column) 0))
 272             (insert indent))))
 273
 274       ;; Step 2: protect backslash and backquote
 275       (yas/replace-all "\\\\" yas/escape-backslash)
 276       (yas/replace-all "\\`" yas/escape-backquote)
 277
 278       ;; Step 3: evaluate all backquotes
 279       (goto-char (point-min))
 280       (while (re-search-forward "`\\([^`]*\\)`" nil t)
 281         (replace-match (yas/eval-string (match-string-no-properties 1))
 282                        t t))
 283
 284       ;; Step 4: protect all escapes, including backslash and backquot
 285       ;; which may be produced in Step 3
 286       (yas/replace-all "\\\\" yas/escape-backslash)
 287       (yas/replace-all "\\`" yas/escape-backquote)
 288       (yas/replace-all "\\$" yas/escape-dollar)
 289
 290       (let ((snippet (yas/make-snippet)))
 291         ;; Step 5: Create fields
 292         (goto-char (point-min))
 293         (while (re-search-forward yas/field-regexp nil t)
 294           (let ((number (match-string-no-properties 1)))
 295             (if (and number
 296                      (string= "0" number))
 297                 (progn
 298                   (replace-match "")
 299                   (setf (yas/snippet-exit-marker snippet)
 300                         (copy-marker (point) t)))
 301               (yas/snippet-add-field
 302                snippet
 303                (yas/make-field
 304                 (make-overlay (match-beginning 0) (match-end 0))
 305                 (and number (string-to-number number))
 306                 (match-string-no-properties 2))))))
 307
 308         ;; Step 6: Sort and link each field group
 309         (setf (yas/snippet-groups snippet)
 310               (sort (yas/snippet-groups snippet)
 311                     '(lambda (group1 group2)
 312                        (yas/snippet-field-compare
 313                         (yas/group-primary-field group1)
 314                         (yas/group-primary-field group2)))))
 315         (let ((prev nil))
 316           (dolist (group (yas/snippet-groups snippet))
 317             (setf (yas/group-prev group) prev)
 318             (when prev
 319               (setf (yas/group-next prev) group))
 320             (setq prev group)))
 321
 322         ;; Step 7: Create keymap overlay for each group
 323         (dolist (group (yas/snippet-groups snippet))
 324           (let* ((overlay (yas/field-overlay (yas/group-primary-field group)))
 325                  (keymap-overlay (make-overlay (overlay-start overlay)
 326                                                (overlay-end overlay)
 327                                                nil
 328                                                nil
 329                                                t)))
 330             (overlay-put keymap-overlay 'keymap yas/keymap)
 331             (setf (yas/group-keymap-overlay group) keymap-overlay)))
 332
 333         ;; Step 8: Replace fields with default values
 334         (dolist (group (yas/snippet-groups snippet))
 335           (let ((value (yas/group-value group)))
 336             (dolist (field (yas/group-fields group))
 337               (let* ((overlay (yas/field-overlay field))
 338                      (start (overlay-start overlay))
 339                      (end (overlay-end overlay))
 340                      (length (- end start)))
 341                 (goto-char start)
 342                 (insert value)
 343                 (delete-char length)))))
 344
 345         ;; Step 9: restore all escape characters
 346         (yas/replace-all yas/escape-dollar "$")
 347         (yas/replace-all yas/escape-backquote "`")
 348         (yas/replace-all yas/escape-backslash "\\")
 349
 350         ;; Step 10: Set up properties of overlays
 351         (dolist (group (yas/snippet-groups snippet))
 352           (let ((overlay (yas/field-overlay
 353                           (yas/group-primary-field group))))
 354             (overlay-put overlay 'yas/snippet snippet)
 355             (overlay-put overlay 'yas/group group)
 356             (overlay-put overlay 'yas/modified? nil)
 357             (overlay-put overlay 'modification-hooks yas/overlay-modification-hooks)
 358             (overlay-put overlay 'insert-in-front-hooks yas/overlay-insert-in-front-hooks)
 359             (overlay-put overlay 'insert-behind-hooks yas/overlay-insert-behind-hooks)
 360             (dolist (field (yas/group-fields group))
 361               (overlay-put (yas/field-overlay field)
 362                            'face
 363                            'highlight))))
 364
 365         ;; Step 11: move to end and make sure exit-marker exist
 366         (goto-char (point-max))
 367         (unless (yas/snippet-exit-marker snippet)
 368           (setf (yas/snippet-exit-marker snippet) (copy-marker (point) t)))
 369
 370         ;; Step 12: Construct undo information
 371         (unless (eq original-undo-list t)
 372           (add-to-list 'original-undo-list
 373                        `(apply yas/undo-expand-snippet
 374                                ,(point-min)
 375                                ,(point-max)
 376                                ,key
 377                                ,snippet)))
 378
 379         ;; Step 13: remove the trigger key
 380         (widen)
 381         (delete-char length)
 382
 383         ;; Step 14: place the cursor at a proper place
 384         (let ((groups (yas/snippet-groups snippet))
 385               (exit-marker (yas/snippet-exit-marker snippet)))
 386           (if groups
 387               (goto-char (overlay-start
 388                           (yas/field-overlay
 389                            (yas/group-primary-field
 390                             (car groups)))))
 391             ;; no need to call exit-snippet, since no overlay created.
 392             (goto-char exit-marker)))
 393
 394         (setq buffer-undo-list original-undo-list)))))
 395
 396 (defun yas/current-snippet-overlay (&optional point)
 397   "Get the most proper overlay which is belongs to a snippet."
 398   (let ((point (or point (point)))
 399         (snippet-overlay nil))
 400     (dolist (overlay (overlays-at point))
 401       (when(overlay-get overlay 'yas/snippet)
 402         (if (null snippet-overlay)
 403             (setq snippet-overlay overlay)
 404           (when (> (yas/snippet-id (overlay-get overlay 'yas/snippet))
 405                    (yas/snippet-id (overlay-get snippet-overlay 'yas/snippet)))
 406             (setq snippet-overlay overlay)))))
 407     snippet-overlay))
 408
 409 (defun yas/current-overlay-for-navigation ()
 410   "Get current overlay for navigation. Might be overlay at current or previous point."
 411   (let ((overlay1 (yas/current-snippet-overlay))
 412         (overlay2 (if (bobp)
 413                       nil
 414                     (yas/current-snippet-overlay (- (point) 1)))))
 415     (if (null overlay1)
 416         overlay2
 417       (if (or (null overlay2)
 418               (eq (overlay-get overlay1 'yas/snippet)
 419                   (overlay-get overlay2 'yas/snippet)))
 420           overlay1
 421         (if (> (yas/snippet-id (overlay-get overlay2 'yas/snippet))
 422                (yas/snippet-id (overlay-get overlay1 'yas/snippet)))
 423             overlay2
 424           overlay1)))))
 425
 426 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 427 ;; User level functions
 428 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 429 (defun yas/define (mode key template)
 430   "Define a snippet. Expanding KEY into TEMPLATE."
 431   (puthash key template (yas/snippet-table mode)))
 432
 433 (defun yas/expand ()
 434   "Expand a snippet. When a snippet is expanded, t is returned,
 435 otherwise, nil returned."
 436   (interactive)
 437   (multiple-value-bind (key start end) (yas/current-key)
 438     (let ((template (yas/template key (yas/current-snippet-table))))
 439       (if template
 440           (progn
 441             (yas/expand-snippet start end template)
 442             t)
 443         nil))))
 444
 445 (defun yas/next-field-group ()
 446   "Navigate to next field group. If there's none, exit the snippet."
 447   (interactive)
 448   (let ((overlay (yas/current-overlay-for-navigation)))
 449     (if overlay
 450         (let ((next (yas/group-next
 451                      (overlay-get overlay 'yas/group))))
 452           (if next
 453               (goto-char (overlay-start
 454                           (yas/field-overlay
 455                            (yas/group-primary-field next))))
 456             (yas/exit-snippet (overlay-get overlay 'yas/snippet))))
 457       (message "Not in a snippet field."))))
 458
 459 (defun yas/prev-field-group ()
 460   "Navigate to prev field group. If there's none, exit the snippet."
 461   (interactive)
 462   (let ((overlay (yas/current-overlay-for-navigation)))
 463     (if overlay
 464         (let ((prev (yas/group-prev
 465                      (overlay-get overlay 'yas/group))))
 466           (if prev
 467               (goto-char (overlay-start
 468                           (yas/field-overlay
 469                            (yas/group-primary-field prev))))
 470             (yas/exit-snippet (overlay-get overlay 'yas/snippet))))
 471       (message "Not in a snippet field."))))
 472
 473 (defun yas/exit-snippet (snippet)
 474   "Goto exit-marker of SNIPPET and delete the snippet."
 475   (interactive)
 476   (goto-char (yas/snippet-exit-marker snippet))
 477   (dolist (group (yas/snippet-groups snippet))
 478     (delete-overlay (yas/group-keymap-overlay group))
 479     (dolist (field (yas/group-fields group))
 480       (delete-overlay (yas/field-overlay field)))))
 481
 482 (provide 'yasnippet)