summaryrefslogtreecommitdiffstats
path: root/emacs.d/lisp/template-simple.el
blob: 60e268b2608fe3d33d66ab84d90d6e5bc23a763a (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
;;; template-simple.el --- Simple template functions and utils

;; Copyright (C) 2007  Ye Wenbin

;; Author: Ye Wenbin <wenbinye@gmail.com>
;; Maintainer: Ye Wenbin <wenbinye@gmail.com>
;; Created: 21 Dec 2007
;; Version: 0.01
;; Keywords: tools, convenience
;; 
;; This file is part of PDE (Perl Development Environment).
;; But it is useful for generic programming.

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; * Why not template?
;;   A template.el is already exists, and it does everything well.
;;   But I hate to read the code to use it in my extension. I need
;;   simple thing to get work done. template-simple is designed
;;   to compatible with template. The two useful features are
;;   implemented, expand template in file and update file header.
;;   And with addtional, you can use this to write simple skeleton
;;   and tempo template. Or you can implement other expand function
;;   to expand the parsed templates.
;;
;; * Where to use it?
;;   You can use it with autoinsert, tempo, skeleton or other related
;;   extensions. I hope this help you to write template for tempo or
;;   skeleton without any knowledge with emacs lisp.
;;
;; * Tips
;;   If you don't like the (>>> and <<<) for open and close paren,
;;   you can overwrite it like file variable in template, for example:
;;
;;   (template-simple-expand
;;    ";; -*- template-parens: (\"{\" . \"}\"); template-expand-function: template-tempo-expand -*-
;;   (defun {p} ({p})
;;     \"{p}\"
;;     {p}
;;     )")
;;
;;   The template is expand by template-tempo-expand and use {} as paren inside
;;   template string.

;;; Dependencies:
;;  no extra libraries is required

;;; Installation:
;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'template-simple)
;;   
;;; Code:
(eval-when-compile
  (require 'cl))


;;; Customizable variables
(defgroup template-simple nil
  "Simple template functions and utils"
  :group 'abbrev
  :group 'convenience
  :group 'pde)

(defcustom template-directory-list
  (append '("~/.templates/")
          (if (boundp 'auto-insert-directory)
              (list auto-insert-directory)))
  "*Directory for lookup template files."
  :type '(repeat directory)
  :group 'template-simple)

(defcustom template-default-alist
  '(("dir" (file-name-directory template-file-name))
    ("file" (file-name-nondirectory template-file-name))
    ("file-sans" (file-name-sans-extension
                  (file-name-nondirectory template-file-name)))
    ("file-ext" (file-name-extension
                 (file-name-nondirectory template-file-name)))
    ("file-upcase" (upcase (file-name-sans-extension
                            (file-name-nondirectory template-file-name))))
    ("date" (format-time-string template-date-format))
    ("cdate" (let ((system-time-locale "C"))
               (format-time-string template-cdate-format)))
    ("iso-date" (format-time-string "%Y-%m-%d"))
    ("vc-date" (prog2
                   (set-time-zone-rule "UTC")
                   (format-time-string "%Y/%m/%d %T")
                 (set-time-zone-rule nil)))
    ("year" (format-time-string "%Y"))
    ("time" (format-time-string template-time-format))
    ("author" (or user-mail-address
                  (concat (user-login-name) "@" (system-name))))
    ("user-name" user-full-name)
    ("login-name" user-login-name)
    ("host-addr" (or mail-host-address (system-name))))
  "*Default expansion list"
  :type '(alist :key-type string :value-type sexp)
  :group 'template-simple)

(defcustom template-date-format "%d %b %Y"
  "*Date format for date in `template-default-alist'."
  :type 'string
  :group 'template-simple)

(defcustom template-cdate-format "%d %b %Y"
  "*Date format for date with `system-time-locale' has value \"C\""
  :type 'string
  :group 'template-simple)

(defcustom template-time-format "%T"
  "*Time format for time in `template-time-format'."
  :type 'string
  :group 'template-simple)

(defcustom template-header-regexp
  '(("@(#)\\([^ \t\n]+\\)" . 1)
    ("^\\([^ \t]\\{,3\\}[ \t]+\\)\\([^ \t\n][^ \t\n]*\\)[ \t]+--" . 2))
  "Alist of regexps matching the file name in the header.
`car' is a regexp to match file header, `cdr' indicate which part
to replace with the file name."
  :type '(alist :key-type regexp :value-type integer)
  :group 'template-simple)

(defcustom template-query t
  "*Non-nil means ask user before expand template or update header."
  :type 'boolean
  :group 'template-simple)

(defvar template-skeleton-alist
  '(("point" _))
  "*Translation between parsed template to skeleton element.")

(defvar template-tempo-alist
  '(("point" p)
    ("p" p))
  "*Translation between parsed template to tempo element.")


;;; Internal variables
(defvar template-expand-function 'template-tempo-expand
  "Functions to expand parsed template.")
(put 'template-expand-function 'safe-local-variable 'functionp)

(defvar template-parens (cons "(>>>" "<<<)")
  "Open and close parenthesis.")
(put 'template-parens 'safe-local-variable 'consp)

(defvar template-file-name nil
  "Internal variable: full name of the file when template expanded.")


;;; Core functions
(defun template-compile ()
  "Parse current buffer to parsed template.
The template can have a file variable line, which can override default
global variable `template-parens' and `template-expand-function'.
The program fragment is surrounded by `template-parens', the escape
char `\\' is used for escape the open parenthesis.
The text in the parentheseses are `read' into a list. For example:
  (template-compile-string
   \";; -*- template-parens: (\\\"{\\\" . \\\"}\\\") -*- 
   (defun {p} ({p})
    \\\"{(read-from-minibuffer \\\"Document: \\\")}\\\"
    )
   \")

  is compile to a list like this:
  (\" (defun \" (p) \" (\" (p) \")
    \\\"\" ((read-from-minibuffer \"Document: \")) \"\\\"
    )
   \")
"
  (save-excursion
    (let ((vars (hack-local-variables-prop-line))
          (beg (point-min))
          (template-parens template-parens)
          open close templates escape)
      (goto-char (point-min))
      (when vars
        (mapc (lambda (var) (set (car var) (cdr var))) vars)
        ;; delete the file variable line for template-simple only
        (forward-line 1)
        (delete-region (point-min) (point)))
      (setq open (regexp-quote (car template-parens))
            close (regexp-quote (cdr template-parens)))
      (while (re-search-forward open nil t)
        (setq escape nil)
        (when (looking-back (concat "\\([^\\]\\|\\`\\)\\([\\]+\\)" open))
          (setq escape (match-string 2))
          (replace-match (substring escape 0 (/ (length escape) 2))
                         nil t nil 2)
          (goto-char (match-end 0))
          ;; if length of escape is odd, just a normal string, continue
          (setq escape (= (% (length escape) 2) 1)))
        (unless escape
          ;; parse template expansion
          (let ((expansion-start (point))
                state done forms)
            (push (buffer-substring-no-properties beg (- (point) (length (car template-parens))))
                  templates)
            (with-syntax-table emacs-lisp-mode-syntax-table
              (while (not done)
                (if (re-search-forward close nil t)
                    (progn
                      (setq state (parse-partial-sexp expansion-start (point)))
                      (if (nth 3 state) ; if inside a string, continue
                          ()
                        (setq done t)))
                  (error "Unmatch parentheses for line %d"
                         (line-number-at-pos expansion-start)))))
            (setq beg (point))
            (save-excursion
              (save-restriction
                (narrow-to-region expansion-start
                                  (- beg (length (cdr template-parens))))
                (goto-char (point-min))
                (while (not (eobp))
                  (push (read (current-buffer)) forms))))
            (push (nreverse forms) templates))))
      (push (buffer-substring-no-properties (point) (point-max)) templates)
      (nreverse templates))))

(defun template-compile-string (str)
  (with-temp-buffer
    (insert str)
    (template-compile)))


;;; Expand functions
(defun template-normal-name (name)
  "Convert all kinds of symbol name to standard name."
  (replace-regexp-in-string "_" "-" (downcase (symbol-name name))))

(defun template-expansion (elem)
  "Lookup name in `template-default-alist'.
If the elem is a list with length more"
  (if (stringp elem)
      (list elem)
    (if (= (length elem) 1)
        (progn
          (setq elem (car elem))
          (list
           (cond ((symbolp elem)
                  (or (cadr (assoc (template-normal-name elem)
                                   template-default-alist))
                      (and (boundp elem) (symbol-value elem))
                      `(or (cadr (assoc (template-normal-name ',elem)
                                        template-default-alist))
                           (let ((str (read-from-minibuffer (format "Replace '%S' with: " ',elem))))
                             (add-to-list 'template-default-alist
                                          (list (template-normal-name ',elem) str))
                             str))))
                 ;; ignore integer
                 ((integerp elem) "")
                 (t elem))))
      elem)))

(defmacro define-template-expander (name alist &rest body)
  "Define a new type of `template-expand-function'.
NAME is used to create a function template-<NAME>-expand.
ALIST can be a symbol or a form to return a list of symbol table add
to template-default-alist.
BODY is the code to expand and insert the template. the value of
variable TEMPLATE is the translated template. The element of parsed
template is translated by `template-expansion'"
  (declare (debug t) (indent 2))
  `(defun ,(intern (format "template-%s-expand" name)) (template)
     ,(format "Expand template by %s" name)
     (let ((template-default-alist
            (append ,alist template-default-alist))
           ;; save global variable 
           (template-expand-function
            ',(intern (format "template-%s-expand" name))))
       (if (stringp template)
           (setq template (template-compile-string template)))
       (setq template (apply 'append (mapcar 'template-expansion template)))
       ,@body)))

(define-template-expander skeleton template-skeleton-alist
  (skeleton-insert (cons nil template)))

(autoload 'tempo-insert-template "tempo")
(define-template-expander tempo template-tempo-alist
  (let ((tempo-template template))
    (tempo-insert-template 'tempo-template nil)))

;;; Exported commands
(defun template-derive-template ()
  "Derive which template file should use for current buffer."
  (when buffer-file-name
    (let ((ext (or (file-name-extension buffer-file-name)
                   (file-name-nondirectory buffer-file-name))))
      (locate-file "TEMPLATE." template-directory-list
                   (list ext (concat ext ".tpl"))))))

;; (defun template-include (name)
;;   (let ((file (locate-file name template-directory-list)))
;;     (when file (template-simple-expand-template file))))

;;;###autoload
(defun template-simple-expand-template (file)
  "Expand template in file.
Parse the template to parsed templates with `template-compile'.
Use `template-expand-function' to expand the parsed template."
  (interactive
   (list
    (let ((def (template-derive-template))
          file)
      (and def (setq def (file-name-nondirectory def)))
      (setq file
            (completing-read
             (if def
                 (format "Insert template(default %s): " def)
               "Insert template: ")
             (apply 'append (mapcar 'directory-files template-directory-list))
             nil t nil nil def))
      (locate-file file template-directory-list))))
  (let ((template-expand-function template-expand-function))
    (template-simple-expand
     (with-temp-buffer
       (insert-file-contents file)
       (template-compile)))))

;;;###autoload
(defun template-simple-expand (template)
  "Expand string TEMPLATE.
Parse the template to parsed templates with `template-compile'.
Use `template-expand-function' to expand the parsed template."
  ;; in case the template-expand-function is overide in template
  (let ((template-file-name (or buffer-file-name
                                (concat (file-name-as-directory default-directory)
                                        (buffer-name))))
        (template-expand-function template-expand-function)
        err)
    (condition-case err
        (progn
          (if (stringp template)
              (setq template (template-compile-string template)))
          (funcall template-expand-function template))
      (error (message "%s: %s" (car err) (cdr err))))))

;;; Commands for write template to string
(defun template-kill-ring-save (beg end)
  "Stringfy text in region, `yank' to see it."
  (interactive "r")
  (kill-new (format "%S" (buffer-substring-no-properties beg end)) nil))

;;; Provide addtional command in template.el
(defun template-simple-update-header ()
  (interactive)
  (when buffer-file-name
    (save-excursion
      (goto-char (point-min))
      (let ((end (progn (forward-line 3) (point)))
                                        ; check only first 3 lines
            (alist template-header-regexp)
            (fn (file-name-sans-versions
                 (file-name-nondirectory buffer-file-name)))
            case-fold-search)
        (while alist
          (goto-char (point-min))
          (if (re-search-forward (caar alist) end t)
              (progn
                (when (not (string= (match-string (cdar alist)) fn))
                  (if (or (null template-query)
                          (y-or-n-p (format "Update file header %s to %s? "
                                            (match-string (cdar alist))
                                            fn)))
                      (replace-match fn nil t nil (cdar alist))))
                (setq alist nil))
            (setq alist (cdr alist)))))))
  ;; return nil for calling other functions
  nil)
;; Hope auto-insert can add a test for template-derive-template
(defun template-auto-insert ()
  (and (not buffer-read-only)
       (or (eq this-command 'template-auto-insert)
           (and (bobp) (eobp)))
       (let ((file (template-derive-template)))
         (when file
           (switch-to-buffer (current-buffer))
           (if (or (null template-query)
                   (y-or-n-p (format "Use template %s? " file)))
               (template-simple-expand-template file)))))
  nil)

(if (boundp 'write-file-functions)
    (add-hook 'write-file-functions 'template-simple-update-header)
  (add-hook 'write-file-hooks 'template-simple-update-header))

(let ((hook (if (boundp 'find-file-hook)
                'find-file-hook
              'find-file-hooks)))
  ;; make template-auto-insert the last, so session history
  ;; will not affect point set by template
  (add-hook hook 'template-auto-insert t)
  ;; make auto-insert lower priority
  (when (memq 'auto-insert (symbol-value hook))
    (remove-hook hook 'auto-insert)
    (add-hook hook 'auto-insert t)))

(provide 'template-simple)
;;; template-simple.el ends here