home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / hm--html-menus / tmpl-minor-mode.el < prev    next >
Encoding:
Text File  |  1995-05-13  |  15.4 KB  |  464 lines
  1. ;;; tmpl-minor-mode.el --- Template Minor Mode
  2. ;;;
  3. ;;; v1.9; 02 Apr 1995
  4. ;;; Copyright (C) 1993, 1994, 1995  Heiko Muenkel
  5. ;;; email: muenkel@tnt.uni-hannover.de
  6. ;;;
  7. ;;; Keywords: data tools
  8. ;;;
  9. ;;;  This program is free software; you can redistribute it and/or modify
  10. ;;;  it under the terms of the GNU General Public License as published by
  11. ;;;  the Free Software Foundation; either version 1, or (at your option)
  12. ;;;  any later version.
  13. ;;;
  14. ;;;  This program is distributed in the hope that it will be useful,
  15. ;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;;;  GNU General Public License for more details.
  18. ;;;
  19. ;;;  You should have received a copy of the GNU General Public License
  20. ;;;  along with this program; if not, write to the Free Software
  21. ;;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22. ;;;
  23. ;;; 
  24. ;;; Commentary:
  25. ;;;
  26. ;;;    This file contains functions to expand templates.
  27. ;;;    Look at the file templates-syntax.doc for the syntax of the 
  28. ;;;    templates.
  29. ;;;    There are the following 2 interactive functions to expand
  30. ;;;    templates:
  31. ;;;        tmpl-expand-templates-in-region
  32. ;;;        tmpl-expand-templates-in-buffer
  33. ;;;    The following two interactive functions are to escape the 
  34. ;;;    unescaped special template signs:
  35. ;;;        tmpl-escape-tmpl-sign-in-region
  36. ;;;        tmpl-escape-tmpl-sign-in-buffer
  37. ;;;    If you want to use keystrokes to call the above functions, you must
  38. ;;;    switch the minor mode tmpl-mode on with `tmpl-minor-mode'. After
  39. ;;;    that, the following keys are defined:
  40. ;;;        `C-c x'     = tmpl-expand-templates-in-region
  41. ;;;        `C-c C-x'     = tmpl-expand-templates-in-buffer
  42. ;;;        `C-c ESC'    = tmpl-escape-tmpl-sign-in-region
  43. ;;;        `C-c C-ESC'    = tmpl-escape-tmpl-sign-in-buffer
  44. ;;;     Type again `M-x tmpl-minor-mode' to switch the template minor mode off.
  45. ;;;
  46. ;;;    This file needs also the file adapt.el !
  47. ;;;
  48. ;;; Installation: 
  49. ;;;   
  50. ;;;    Put this file in one of your lisp directories and the following
  51. ;;;    lisp command in your .emacs:
  52. ;;;        (load-library "templates")
  53. ;;;
  54.  
  55. (require 'adapt)
  56.  
  57.  
  58. (defvar tmpl-sign "" "Sign which marks a template expression.")
  59.  
  60.  
  61. (defvar tmpl-name-lisp "LISP" "Name of the lisp templates.")
  62.  
  63.  
  64. (defvar tmpl-name-command "COMMAND" "Name of the emacs command templates.")
  65.  
  66.  
  67. (defvar tmpl-name-comment "C" "Name of a comment template.")
  68.  
  69.  
  70. (defvar tmpl-attribute-delete-line 'DELETE-LINE 
  71.   "Attribute name of the attribute `delete-line`.")
  72.  
  73.  
  74. (defvar tmpl-attribute-dont-delete 'DONT-DELETE
  75.   "Attribute name of the attribute `dont-delete`.")
  76.  
  77.  
  78. (defvar tmpl-end-template "END" "End of a template.")
  79.  
  80.  
  81. (defvar tmpl-white-spaces "     
  82.  
  83. " "String with white spaces.")
  84.  
  85.  
  86. (defmacro tmpl-save-excursion (&rest body)
  87.   "Put `save-excursion' and `save-window-excursion' around the body."
  88.   (`(save-excursion
  89.       (, (cons 'save-window-excursion
  90.            body)))))
  91.  
  92.  
  93. (defun tmpl-current-line ()
  94.   "Returns the current line number."
  95.   (save-restriction
  96.     (widen)
  97.     (save-excursion
  98.       (beginning-of-line)
  99.       (1+ (count-lines 1 (point))))))
  100.  
  101.  
  102. ;(defun mapcar* (f &rest args)
  103. ;  "Apply FUNCTION to successive cars of all ARGS, until one ends.
  104. ;Return the list of results."
  105. ;  (if (not (memq 'nil args))              ; If no list is exhausted,
  106. ;      (cons (apply f (mapcar 'car args))  ; Apply function to CARs.
  107. ;        (apply 'mapcar* f             ; Recurse for rest of elements.
  108. ;           (mapcar 'cdr args)))))
  109. ;
  110. ;(defmacro tmpl-error (&rest args)
  111. ;  "Widen the buffer and signal an error.
  112. ;Making error message by passing all args to `error',
  113. ;which passes all args to format."
  114. ;  (widen)
  115. ;  (error args))
  116.  
  117.  
  118. (defun tmpl-search-next-template-sign (&optional dont-unescape)
  119.   "Search the next template sign after the current point.
  120. It returns t, if a template is found and nil otherwise.
  121. If DONT-UNESCAPE is t, then the escaped template signs are not unescaped."
  122.   (if (search-forward tmpl-sign nil t)
  123.     (if (or (eq (point) (point-max))
  124.         (not (string= tmpl-sign
  125.                   (buffer-substring (point) (+ (length tmpl-sign) 
  126.                                (point))))))
  127.         t
  128.       (if (not dont-unescape)
  129.           (delete-char (length tmpl-sign))
  130.         (forward-char))
  131.       (tmpl-search-next-template-sign dont-unescape))))
  132.  
  133.  
  134. (defun tmpl-get-template-tag ()
  135.   "Return a string with the template tag.
  136. That is the string from the current point to the next `tmpl-sign',
  137. without the tmpl-sign. The point is set after the `tmpl-sign'."
  138.   (let ((template-start (point)))
  139.     (if (tmpl-search-next-template-sign)
  140.     (buffer-substring template-start (- (point) (length tmpl-sign)))
  141.       nil)))
  142.  
  143.  
  144. (defun tmpl-get-template-name (template-string)
  145.   "Returns the name of the template in the TEMPLATE-STRING."
  146.   (let* ((start (string-match (concat "[^"
  147.                       tmpl-white-spaces
  148.                       "]")
  149.                   template-string))
  150.      (end (string-match (concat "["
  151.                     tmpl-white-spaces
  152.                     "]")
  153.                 template-string start)))
  154.     (if end
  155.     (substring template-string start end)
  156.       (substring template-string start))))
  157.  
  158.  
  159. (defun tmpl-get-template-attribute-list (template-string)
  160.   "Returns the attribute list (as a lisp list) from the template-string."
  161.   (let* ((start (string-match (concat "[^"
  162.                       tmpl-white-spaces
  163.                       "]")
  164.                   template-string)))
  165.     (setq start (string-match (concat "["
  166.                       tmpl-white-spaces
  167.                       "]")
  168.                   template-string start))
  169.     (if start
  170.     (car (read-from-string template-string start))
  171.       nil)))
  172.  
  173.  
  174. (defun template-delete-template (begin-of-template template-attribute-list)
  175.   "Delete the current template from BEGIN-OF-TEMPLATE to the current point."
  176.   (tmpl-save-excursion
  177.     (if (or (not (assoc tmpl-attribute-dont-delete template-attribute-list))
  178.         (not (car (cdr (assoc tmpl-attribute-dont-delete 
  179.                   template-attribute-list)))))
  180.     (if (and (assoc tmpl-attribute-delete-line template-attribute-list)
  181.          (car (cdr (assoc tmpl-attribute-delete-line
  182.                   template-attribute-list))))
  183.         (let ((end-of-template (point))
  184.           (diff 1))
  185.           (skip-chars-forward " \t") ; Skip blanks and tabs
  186.           (if (string= "\n" (buffer-substring (point) (1+ (point)))) 
  187.           (progn
  188.             (setq diff 0) ; don't delete the linefeed at the beginnig
  189.             (setq end-of-template (1+ (point)))))
  190.           (goto-char begin-of-template)
  191.           (skip-chars-backward " \t") ; Skip blanks and tabs
  192.           (if (eq (point) (point-min))
  193.           (delete-region (point) end-of-template)
  194.         (if (string= "\n" (buffer-substring (1- (point)) (point)))
  195.             (delete-region (- (point) diff) end-of-template)
  196.           (delete-region begin-of-template end-of-template))))
  197.       (delete-region begin-of-template (point))))))
  198.  
  199.  
  200. (defun tmpl-expand-comment-template (begin-of-template template-attribute-list)
  201.   "Expand the comment template, which starts at the point BEGIN-OF-TEMPLATE.
  202. TEMPLATE-ATTRIBUTE-LIST is the attribute list of the template."
  203.   (end-of-line)
  204.   (template-delete-template begin-of-template template-attribute-list))
  205. ;  (tmpl-save-excursion
  206. ;    (if (or (not (assoc tmpl-attribute-dont-delete template-attribute-list))
  207. ;        (not (car (cdr (assoc tmpl-attribute-dont-delete 
  208. ;                  template-attribute-list)))))
  209. ;    (if (and (assoc tmpl-attribute-delete-line template-attribute-list)
  210. ;         (car (cdr (assoc tmpl-attribute-delete-line
  211. ;                  template-attribute-list))))
  212. ;        ;; Delete the whole line
  213. ;        (let ((end-of-region (progn (end-of-line) (point)))
  214. ;          (start-of-region begin-of-template)) ; ausgetauscht
  215. ;          (delete-region start-of-region end-of-region)
  216. ;          (delete-char 1))
  217. ;      ;; Delete only the comment
  218. ;      (let ((end-of-region (progn
  219. ;                 (end-of-line)
  220. ;                 (point)))
  221. ;        (start-of-region (progn (goto-char begin-of-template)
  222. ;                    (point))))
  223. ;        (delete-region start-of-region end-of-region))))))
  224.   
  225.  
  226. (defun tmpl-get-template-argument ()
  227.   "Return the Text between a start tag and the end tag as symbol.
  228. The point must be after the `templ-sign' of the start tag.
  229. After this function has returned, the point is after the
  230. first `templ-sign' of the end tag."
  231.   (let ((start-of-argument-text (progn (skip-chars-forward tmpl-white-spaces) 
  232.                        (point))))
  233.     (if (tmpl-search-next-template-sign)
  234.     (car (read-from-string (buffer-substring start-of-argument-text
  235.                          (- (point) 
  236.                             (length tmpl-sign)))))
  237.       (widen)
  238.       (error "Error Before Line %d: First Template Sign Of End Tag Missing !"
  239.          (tmpl-current-line)))))
  240.  
  241.  
  242. (defun tmpl-make-list-of-words-from-string (string)
  243.   "Return a list of words which occur in the string."
  244.   (cond ((or (not (stringp string)) (string= "" string))
  245.      ())
  246.     (t (let* ((end-of-first-word (string-match 
  247.                       (concat "[" 
  248.                           tmpl-white-spaces 
  249.                           "]") 
  250.                       string))
  251.           (rest-of-string (substring string (1+ 
  252.                              (or 
  253.                               end-of-first-word
  254.                               (1- (length string)))))))
  255.          (cons (substring string 0 end-of-first-word)
  256.            (tmpl-make-list-of-words-from-string 
  257.             (substring rest-of-string (or 
  258.                            (string-match 
  259.                         (concat "[^" 
  260.                             tmpl-white-spaces 
  261.                             "]")
  262.                         rest-of-string)
  263.                            0))))))))
  264.  
  265.  
  266. (defun tmpl-get-template-end-tag ()
  267.   "Return a list with the elements of the following end tag.
  268. The point must be after the first `templ-sign' of the end tag.
  269. After this function has returned, the point is after the
  270. last `templ-sign' of the end tag."
  271.   (let* ((start-point (progn (skip-chars-forward tmpl-white-spaces) 
  272.                  (point)))
  273.      (end-tag-string (if (tmpl-search-next-template-sign)
  274.                  (buffer-substring start-point
  275.                            (- (point) (length tmpl-sign)))
  276.                (widen)
  277.                (error "Error Before Line %d: Last Template Sign Of End Tag Missing !" 
  278.                   (tmpl-current-line)))))
  279.     (tmpl-make-list-of-words-from-string end-tag-string)
  280.   ))
  281.  
  282.  
  283. (defun tmpl-expand-command-template (begin-of-template template-attribute-list)
  284.   "Expand the command template, which starts at the point BEGIN-OF-TEMPLATE.
  285. TEMPLATE-ATTRIBUTE-LIST is the attribute list of the template."
  286.   (let ((template-argument (tmpl-get-template-argument))
  287.     (template-end-tag (tmpl-get-template-end-tag)))
  288.     (if (equal (list tmpl-end-template tmpl-name-command)
  289.            template-end-tag)
  290.     (tmpl-save-excursion
  291.       (save-restriction
  292.         (widen)
  293.         (template-delete-template begin-of-template 
  294.                       template-attribute-list)
  295.         (command-execute template-argument)))
  296.       (widen)
  297.       (error "ERROR in Line %d: Wrong Template Command End Tag"
  298.          (tmpl-current-line)))))
  299.  
  300.  
  301. (defun tmpl-expand-lisp-template (begin-of-template template-attribute-list)
  302.   "Expand the lisp template, which starts at the point BEGIN-OF-TEMPLATE.
  303. TEMPLATE-ATTRIBUTE-LIST is the attribute list of the template."
  304.   (let ((template-argument (tmpl-get-template-argument))
  305.     (template-end-tag (tmpl-get-template-end-tag)))
  306.     (if (equal (list tmpl-end-template tmpl-name-lisp)
  307.            template-end-tag)
  308.     (tmpl-save-excursion
  309.       (save-restriction
  310.         (widen)
  311.         (template-delete-template begin-of-template 
  312.                       template-attribute-list)
  313.         (eval template-argument)))
  314.       (widen)
  315.       (error "ERROR in Line %d: Wrong Template Lisp End Tag"
  316.          (tmpl-current-line)))))
  317.  
  318.  
  319. (defun tmpl-expand-template-at-point ()
  320.   "Expand the template at the current point.
  321. The point must be after the sign ^@."
  322.   (let ((begin-of-template (- (point) (length tmpl-sign)))
  323.     (template-tag (tmpl-get-template-tag)))
  324.     (if (not template-tag) 
  325.     (progn
  326.       (widen)
  327.       (error "ERROR In Line %d: End Sign Of Template Tag Missing !"
  328.          (tmpl-current-line)))
  329.       (let ((template-name (tmpl-get-template-name template-tag))
  330.         (template-attribute-list (tmpl-get-template-attribute-list 
  331.                       template-tag)))
  332.     (cond ((not template-name)
  333.            (widen)
  334.            (error "ERROR In Line %d: No Template Name"
  335.               (tmpl-current-line)))
  336.           ((string= tmpl-name-comment template-name)
  337.            ;; comment template found
  338.            (tmpl-expand-comment-template begin-of-template
  339.                          template-attribute-list))
  340.           ((string= tmpl-name-command template-name)
  341.            ;; command template found
  342.            (tmpl-expand-command-template begin-of-template
  343.                          template-attribute-list))
  344.           ((string= tmpl-name-lisp template-name)
  345.            ;; lisp template found
  346.            (tmpl-expand-lisp-template begin-of-template
  347.                          template-attribute-list))
  348.           (t (widen)
  349.          (error "ERROR In Line %d: Wrong Template Name (%s) !"
  350.             (tmpl-current-line) template-name)))))))
  351.  
  352. ;;;###autoload
  353. (defun tmpl-expand-templates-in-region (&optional begin end)
  354.   "Expand the templates in the region from BEGIN to END.
  355. If BEGIN and and are nil, then the current region is used."
  356.   (interactive)
  357.   (tmpl-save-excursion
  358.     (narrow-to-region (or begin (region-beginning))
  359.               (or end (region-end)))
  360.     (goto-char (point-min))
  361.     (while (tmpl-search-next-template-sign)
  362.       (tmpl-expand-template-at-point))
  363.     (widen)))
  364.  
  365.  
  366. ;;;###autoload
  367. (defun tmpl-expand-templates-in-buffer ()
  368.   "Expand all templates in the current buffer."
  369.   (interactive)
  370.   (tmpl-expand-templates-in-region (point-min) (point-max)))
  371.  
  372.  
  373. (defun tmpl-escape-tmpl-sign-in-region (&optional begin end)
  374.   "Escape all `tmpl-sign' with a `tmpl-sign' in the region from BEGIN to END.
  375. If BEGIN and END are nil, then the active region between mark and point is 
  376. used."
  377.   (interactive)
  378.     (save-excursion
  379.       (narrow-to-region (or begin (region-beginning))
  380.             (or end (region-end)))
  381.       (goto-char (point-min))
  382.       (while (tmpl-search-next-template-sign t)
  383.     (insert tmpl-sign))
  384.       (widen)))
  385.  
  386.  
  387. (defun tmpl-escape-tmpl-sign-in-buffer ()
  388.   "Escape all `tmpl-sign' with a `tmpl-sign' in the buffer."
  389.   (interactive)
  390.   (tmpl-escape-tmpl-sign-in-region (point-min) (point-max)))
  391.  
  392.  
  393. ;;; Definition of the minor mode tmpl
  394.  
  395. (defvar tmpl-minor-mode nil
  396.   "*t, if the minor mode tmpl-mode is on and nil otherwise.")
  397.  
  398.  
  399. (make-variable-buffer-local 'tmpl-minor-mode)
  400. ;(set-default 'tmpl-minor-mode nil)
  401.  
  402.  
  403. (defvar tmpl-old-local-map nil
  404.   "Local keymap, before the minor-mode tmpl was switched on.")
  405.  
  406.  
  407. (make-variable-buffer-local 'tmpl-old-local-map)
  408.  
  409.  
  410.  
  411. (defvar tmpl-minor-mode-map nil
  412.   "*The keymap for the minor mode tmpl-mode.")
  413.  
  414.  
  415. (make-variable-buffer-local 'tmpl-minor-mode-map)
  416.  
  417.  
  418. (if (adapt-xemacsp)
  419.     (defun tmpl-define-minor-mode-keymap ()
  420.       "Defines the minor mode keymap."
  421.       (define-key tmpl-minor-mode-map [(control c) x] 
  422.     'tmpl-expand-templates-in-region)
  423.       (define-key tmpl-minor-mode-map [(control c) (control x)] 
  424.     'tmpl-expand-templates-in-buffer)
  425.       (define-key tmpl-minor-mode-map [(control c) escape] 
  426.     'tmpl-escape-tmpl-sign-in-region)
  427.       (define-key tmpl-minor-mode-map [(control c) (control escape)]
  428.     'tmpl-escape-tmpl-sign-in-buffer))
  429.   (defun tmpl-define-minor-mode-keymap ()
  430.     "Defines the minor mode keymap."
  431.     (define-key tmpl-minor-mode-map [?\C-c ?x] 
  432.       'tmpl-expand-templates-in-region)
  433.     (define-key tmpl-minor-mode-map [?\C-c ?\C-x] 
  434.       'tmpl-expand-templates-in-buffer)
  435.     (define-key tmpl-minor-mode-map [?\C-c escape] 
  436.       'tmpl-escape-tmpl-sign-in-region)
  437.     (define-key tmpl-minor-mode-map [?\C-c C-escape]
  438.       'tmpl-escape-tmpl-sign-in-buffer))
  439.     )
  440.  
  441.  
  442. (defun tmpl-minor-mode ()
  443.   "Toggle the minor mode tmpl-mode."
  444.   (interactive)
  445.   (if tmpl-minor-mode
  446.       (progn
  447.     (setq tmpl-minor-mode nil)
  448.     (use-local-map tmpl-old-local-map)
  449.     (setq tmpl-old-local-map nil))
  450.     (setq tmpl-minor-mode t)
  451.     (setq tmpl-old-local-map (current-local-map))
  452.     (if tmpl-old-local-map
  453.     (setq tmpl-minor-mode-map (copy-keymap tmpl-old-local-map))
  454.       (setq tmpl-minor-mode-map nil)
  455.       (setq tmpl-minor-mode-map (make-keymap))
  456.       (set-keymap-name tmpl-minor-mode-map 'minor-mode-map))
  457.     (tmpl-define-minor-mode-keymap)
  458.     (use-local-map tmpl-minor-mode-map)))
  459.  
  460.  
  461. (setq minor-mode-alist (cons '(tmpl-minor-mode " TMPL") minor-mode-alist))
  462.  
  463.  
  464. (provide 'tmpl-minor-mode)
  465.