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   snippet)
  96 (defstruct (yas/field (:constructor yas/make-field (overlay number value)))
  97   "A field in a snippet."
  98   overlay
  99   number
 100   value)
 101
 102 (defun yas/snippet-add-field (snippet field)
 103   "Add FIELD to SNIPPET."
 104   (let ((group (find field
 105                      (yas/snippet-groups snippet)
 106                      :test
 107                      '(lambda (field group)
 108                         (= (yas/field-number field)
 109                            (yas/group-number group))))))
 110     (if group
 111         (yas/group-add-field group field)
 112       (push (yas/make-group field snippet)
 113             (yas/snippet-groups snippet)))))
 114
 115 (defun yas/group-value (group)
 116   "Get the default value of the field group."
 117   (or (yas/field-value
 118        (yas/group-primary-field group))
 119       "(no default value)"))
 120 (defun yas/group-number (group)
 121   "Get the number of the field group."
 122   (yas/field-number
 123    (yas/group-primary-field group)))
 124 (defun yas/group-add-field (group field)
 125   "Add a field to the field group. If the value of the primary
 126 field is nil and that of the field is not nil, the field is set
 127 as the primary field of the group."
 128   (push field (yas/group-fields group))
 129   (when (and (null (yas/field-value (yas/group-primary-field group)))
 130              (yas/field-value field))
 131     (setf (yas/group-primary-field group) field)))
 132
 133 (defun yas/snippet-field-compare (field1 field2)
 134   "Compare two fields. The field with a number is sorted first.
 135 If they both have a number, compare through the number. If neither
 136 have, compare through the start point of the overlay."
 137   (let ((n1 (yas/field-number field1))
 138         (n2 (yas/field-number field2)))
 139     (if n1
 140         (if n2
 141             (< n1 n2)
 142           t)
 143       (if n2
 144           nil
 145         (< (overlay-start (yas/field-overlay field1))
 146            (overlay-start (yas/field-overlay field2)))))))
 147
 148 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 149 ;; Internal functions
 150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 151 (defun yas/eval-string (string)
 152   "Evaluate STRING and convert the result to string."
 153   (condition-case err
 154       (format "%s" (eval (read string)))
 155     (error (format "(error in elisp evaluation: %s)"
 156                    (error-message-string err)))))
 157 (defsubst yas/replace-all (from to)
 158   "Replace all occurance from FROM to TO."
 159   (goto-char (point-min))
 160   (while (search-forward from nil t)
 161     (replace-match to t t)))
 162 (defun yas/snippet-table (mode)
 163   "Get the snippet table corresponding to MODE."
 164   (let ((table (gethash mode yas/snippet-tables)))
 165     (unless table
 166       (setq table (make-hash-table :test 'equal))
 167       (puthash mode table yas/snippet-tables))
 168     table))
 169 (defsubst yas/current-snippet-table ()
 170   "Get the snippet table for current major-mode."
 171   (yas/snippet-table major-mode))
 172
 173 (defsubst yas/template (key snippet-table)
 174   "Get template for KEY in SNIPPET-TABLE."
 175   (gethash key snippet-table))
 176
 177 (defun yas/current-key ()
 178   "Get the key under current position. A key is used to find
 179 the template of a snippet in the current snippet-table."
 180   (let ((start (point))
 181         (end (point)))
 182     (save-excursion
 183       (skip-syntax-backward yas/key-syntax)
 184       (setq start (point))
 185       (list (buffer-substring-no-properties start end)
 186             start
 187             end))))
 188
 189 (defun yas/synchronize-fields (field-group)
 190   "Update all fields' text according to the primary field."
 191   (save-excursion
 192     (let* ((inhibit-modification-hooks t)
 193            (primary (yas/group-primary-field field-group))
 194            (primary-overlay (yas/field-overlay primary))
 195            (text (buffer-substring-no-properties (overlay-start primary-overlay)
 196                                                  (overlay-end primary-overlay))))
 197       (dolist (field (yas/group-fields field-group))
 198         (let* ((field-overlay (yas/field-overlay field))
 199                (original-length (- (overlay-end field-overlay)
 200                                    (overlay-start field-overlay))))
 201           (unless (eq field-overlay primary-overlay)
 202             (goto-char (overlay-start field-overlay))
 203             (insert text)
 204             (delete-char original-length)))))))
 205
 206 (defun yas/overlay-modification-hook (overlay after? beg end &optional length)
 207   "Modification hook for snippet field overlay."
 208   (when (and after? (not undo-in-progress))
 209     (yas/synchronize-fields (overlay-get overlay 'yas/group))))
 210 (defun yas/overlay-insert-in-front-hook (overlay after? beg end &optional length)
 211   "Hook for snippet overlay when text is inserted in front of a snippet field."
 212   (when after?
 213     (let ((field-group (overlay-get overlay 'yas/group)))
 214       (when (not (overlay-get overlay 'yas/modified?))
 215         (let ((inhibit-modification-hooks t))
 216           (overlay-put overlay 'yas/modified? t)
 217           (save-excursion
 218             (goto-char end)
 219             (delete-char (- (overlay-end overlay) end)))))
 220       (yas/synchronize-fields field-group))))
 221 (defun yas/overlay-insert-behind-hook (overlay after? beg end &optional length)
 222   "Hook for snippet overlay when text is inserted just behind a snippet field."
 223   (when (and after?
 224              (null (yas/current-snippet-overlay beg))) ; not inside another field
 225     (move-overlay overlay
 226                   (overlay-start overlay)
 227                   end)
 228     (yas/synchronize-fields
 229      (overlay-get overlay 'yas/group))))
 230
 231 (defun yas/expand-snippet (start end template)
 232   "Expand snippet at current point. Text between START and END
 233 will be deleted before inserting template."
 234   (goto-char start)
 235
 236   (let ((length (- end start))
 237         (column (current-column)))
 238     (save-restriction
 239       (narrow-to-region start start)
 240
 241       (insert template)
 242       ;; Step 1: do necessary indent
 243       (when yas/indent-line
 244         (let* ((indent (if indent-tabs-mode
 245                            (concat (make-string (/ column tab-width) ?\t)
 246                                    (make-string (% column tab-width) ?\ ))
 247                          (make-string column ?\ ))))
 248           (goto-char (point-min))
 249           (while (and (zerop (forward-line))
 250                       (= (current-column) 0))
 251             (insert indent))))
 252
 253       ;; Step 2: protect backslash and backquote
 254       (yas/replace-all "\\\\" yas/escape-backslash)
 255       (yas/replace-all "\\`" yas/escape-backquote)
 256
 257       ;; Step 3: evaluate all backquotes
 258       (goto-char (point-min))
 259       (while (re-search-forward "`\\([^`]*\\)`" nil t)
 260         (replace-match (yas/eval-string (match-string-no-properties 1))
 261                        t t))
 262
 263       ;; Step 4: protect all escapes, including backslash and backquot
 264       ;; which may be produced in Step 3
 265       (yas/replace-all "\\\\" yas/escape-backslash)
 266       (yas/replace-all "\\`" yas/escape-backquote)
 267       (yas/replace-all "\\$" yas/escape-dollar)
 268
 269       (let ((snippet (yas/make-snippet)))
 270         ;; Step 5: Create fields
 271         (goto-char (point-min))
 272         (while (re-search-forward yas/field-regexp nil t)
 273           (let ((number (match-string-no-properties 1)))
 274             (if (and number
 275                      (string= "0" number))
 276                 (progn
 277                   (replace-match "")
 278                   (setf (yas/snippet-exit-marker snippet)
 279                         (copy-marker (point) t)))
 280               (yas/snippet-add-field
 281                snippet
 282                (yas/make-field
 283                 (make-overlay (match-beginning 0) (match-end 0))
 284                 (and number (string-to-number number))
 285                 (match-string-no-properties 2))))))
 286
 287         ;; Step 6: Sort and link each field group
 288         (setf (yas/snippet-groups snippet)
 289               (sort (yas/snippet-groups snippet)
 290                     '(lambda (group1 group2)
 291                        (yas/snippet-field-compare
 292                         (yas/group-primary-field group1)
 293                         (yas/group-primary-field group2)))))
 294         (let ((prev nil))
 295           (dolist (group (yas/snippet-groups snippet))
 296             (setf (yas/group-prev group) prev)
 297             (when prev
 298               (setf (yas/group-next prev) group))
 299             (setq prev group)))
 300
 301         ;; Step 7: Replace fields with default values
 302         (dolist (group (yas/snippet-groups snippet))
 303           (let ((value (yas/group-value group)))
 304             (dolist (field (yas/group-fields group))
 305               (let* ((overlay (yas/field-overlay field))
 306                      (start (overlay-start overlay))
 307                      (end (overlay-end overlay))
 308                      (length (- end start)))
 309                 (goto-char start)
 310                 (insert value)
 311                 (delete-char length)))))
 312
 313         ;; Step 8: restore all escape characters
 314         (yas/replace-all yas/escape-dollar "$")
 315         (yas/replace-all yas/escape-backquote "`")
 316         (yas/replace-all yas/escape-backslash "\\")
 317
 318         ;; Step 9: Set up properties of overlays, including keymaps
 319         (dolist (group (yas/snippet-groups snippet))
 320           (let ((overlay (yas/field-overlay
 321                           (yas/group-primary-field group))))
 322             (overlay-put overlay 'keymap yas/keymap)
 323             (overlay-put overlay 'yas/snippet snippet)
 324             (overlay-put overlay 'yas/group group)
 325             (overlay-put overlay 'yas/modified? nil)
 326             (overlay-put overlay 'modification-hooks yas/overlay-modification-hooks)
 327             (overlay-put overlay 'insert-in-front-hooks yas/overlay-insert-in-front-hooks)
 328             (overlay-put overlay 'insert-behind-hooks yas/overlay-insert-behind-hooks)
 329             (dolist (field (yas/group-fields group))
 330               (overlay-put (yas/field-overlay field)
 331                            'face
 332                            'highlight))))
 333
 334         ;; Step 10: move to end and make sure exit-marker exist
 335         (goto-char (point-max))
 336         (unless (yas/snippet-exit-marker snippet)
 337           (setf (yas/snippet-exit-marker snippet) (copy-marker (point) t)))
 338
 339         ;; Step 11: remove the trigger key
 340         (widen)
 341         (delete-char length)
 342
 343         ;; Step 12: place the cursor at a proper place
 344         (let ((groups (yas/snippet-groups snippet))
 345               (exit-marker (yas/snippet-exit-marker snippet)))
 346           (if groups
 347               (goto-char (overlay-start
 348                           (yas/field-overlay
 349                            (yas/group-primary-field
 350                             (car groups)))))
 351             ;; no need to call exit-snippet, since no overlay created.
 352             (goto-char exit-marker)))))))
 353
 354 (defun yas/current-snippet-overlay (&optional point)
 355   "Get the most proper overlay which is belongs to a snippet."
 356   (let ((point (or point (point)))
 357         (snippet-overlay nil))
 358     (dolist (overlay (overlays-at point))
 359       (when (overlay-get overlay 'yas/snippet)
 360         (if (null snippet-overlay)
 361             (setq snippet-overlay overlay)
 362           (when (> (yas/snippet-id (overlay-get overlay 'yas/snippet))
 363                    (yas/snippet-id (overlay-get snippet-overlay 'yas/snippet)))
 364             (setq snippet-overlay overlay)))))
 365     snippet-overlay))
 366
 367 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 368 ;; User level functions
 369 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 370 (defun yas/define (mode key template)
 371   "Define a snippet. Expanding KEY into TEMPLATE."
 372   (puthash key template (yas/snippet-table mode)))
 373
 374 (defun yas/expand ()
 375   "Expand a snippet. When a snippet is expanded, t is returned,
 376 otherwise, nil returned."
 377   (interactive)
 378   (multiple-value-bind (key start end) (yas/current-key)
 379     (let ((template (yas/template key (yas/current-snippet-table))))
 380       (if template
 381           (progn
 382             (yas/expand-snippet start end template)
 383             t)
 384         nil))))
 385
 386 (defun yas/next-field-group ()
 387   "Navigate to next field group. If there's none, exit the snippet."
 388   (interactive)
 389   (let ((overlay (yas/current-snippet-overlay)))
 390     (if overlay
 391         (let ((next (yas/group-next
 392                      (overlay-get overlay 'yas/group))))
 393           (if next
 394               (goto-char (overlay-start
 395                           (yas/field-overlay
 396                            (yas/group-primary-field next))))
 397             (yas/exit-snippet (overlay-get overlay 'yas/snippet))))
 398       (message "Not in a snippet field."))))
 399
 400 (defun yas/prev-field-group ()
 401   "Navigate to prev field group. If there's none, exit the snippet."
 402   (interactive)
 403   (let ((overlay (yas/current-snippet-overlay)))
 404     (if overlay
 405         (let ((prev (yas/group-prev
 406                      (overlay-get overlay 'yas/group))))
 407           (if prev
 408               (goto-char (overlay-start
 409                           (yas/field-overlay
 410                            (yas/group-primary-field prev))))
 411             (yas/exit-snippet (overlay-get overlay 'yas/snippet))))
 412       (message "Not in a snippet field."))))
 413
 414 (defun yas/exit-snippet (snippet)
 415   "Goto exit-marker of SNIPPET and delete the snippet."
 416   (interactive)
 417   (goto-char (yas/snippet-exit-marker snippet))
 418   (dolist (group (yas/snippet-groups snippet))
 419     (dolist (field (yas/group-fields group))
 420       (delete-overlay (yas/field-overlay field)))))
 421
 422 (provide 'yasnippet)