1 ;;; wl-template.el --- Draft template feature for Wanderlust.
3 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
4 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Author: Masahiro MURATA <muse@ba2.so-net.ne.jp>
7 ;; Keywords: mail, net news
9 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
34 (defvar wl-template-default-name "default")
35 (defvar wl-template-buffer-name "*WL-Template*")
36 (defvar wl-template-mode-map nil)
38 (defvar wl-template nil)
39 (defvar wl-template-cur-num 0)
40 (defvar wl-template-max-num 0)
41 (defvar wl-template-draft-buffer nil)
42 (defvar wl-template-preview nil)
46 (if wl-template-mode-map
48 (setq wl-template-mode-map (make-sparse-keymap))
49 (define-key wl-template-mode-map "p" 'wl-template-prev)
50 (define-key wl-template-mode-map "n" 'wl-template-next)
51 (define-key wl-template-mode-map "q" 'wl-template-abort)
52 (define-key wl-template-mode-map "\r" 'wl-template-set)
53 (define-key wl-template-mode-map "\n" 'wl-template-set))
55 (defun wl-template-preview-p ()
56 "Return non-nil when preview template."
59 (defun wl-template-apply (name)
60 "Apply NAME template to draft."
64 (setq name wl-template-default-name))
65 (when (setq template (cdr (assoc name wl-template-alist)))
67 (setq wl-draft-config-variables
69 (nconc wl-draft-config-variables
71 (wl-draft-config-exec-sub template)))))
73 (if wl-highlight-body-too
74 (let ((beg (point-min))
76 (put-text-property beg end 'face nil)
77 (wl-highlight-message beg end t))))))))
79 (defun wl-template-mode ()
80 "Major mode for Wanderlust template.
81 See info under Wanderlust for full documentation.
85 Entering WL-Template mode calls the value of `wl-template-mode-hook'."
86 (kill-all-local-variables)
87 (setq mode-name "Wl-Template"
88 major-mode 'wl-template-mode)
89 (use-local-map wl-template-mode-map)
90 (setq buffer-read-only t)
91 (run-hooks 'wl-template-mode-hook))
93 (defun wl-template-select (&optional arg)
94 "Select template from `wl-template-alist'."
96 (unless wl-template-alist
97 (error "Please set `wl-template-alist'"))
99 (not wl-template-visible-select)
100 wl-template-visible-select))
102 (completing-read (format "Template (%s): " wl-template-default-name)
104 (let* ((begin wl-template-default-name)
105 (work wl-template-alist))
106 (if (and begin (cdr (assoc begin wl-template-alist)))
107 (while (not (string= (car (car work)) begin))
108 (setq wl-template-cur-num (1+ wl-template-cur-num))
109 (setq work (cdr work))))
110 (setq wl-template nil
111 wl-template-cur-num 0
112 wl-template-max-num (length wl-template-alist))
113 (setq wl-template-draft-buffer (current-buffer))
114 (if (get-buffer-window wl-template-buffer-name)
115 (select-window (get-buffer-window wl-template-buffer-name))
116 (let* ((cur-win (selected-window))
118 (- (window-height cur-win)
120 (- (window-height cur-win)
121 (max window-min-height
122 (1+ wl-template-buffer-lines))))))
123 (split-window cur-win (if (> size 0) size window-min-height))
124 ;; goto the bottom of the two...
125 (select-window (next-window))
126 ;; make it display...
127 (let ((pop-up-windows nil))
128 (switch-to-buffer (get-buffer-create wl-template-buffer-name)))))
129 (set-buffer wl-template-buffer-name)
131 (wl-template-show))))
133 (defun wl-template-show (&optional arg)
134 "Show reference INDEX in `wl-template-alist'.
135 ARG is ignored." ; ARG ignored this version (?)
137 (set-buffer wl-template-buffer-name)
138 (let ((buffer-read-only nil)
139 (wl-template-preview t)
140 (mail-header-separator "--header separater--"))
142 (goto-char (point-min))
144 (setq wl-template (car (nth wl-template-cur-num wl-template-alist)))
145 mail-header-separator)
146 (wl-highlight-message (point-min) (point-max) t)
147 (when wl-highlight-x-face-function
148 (funcall wl-highlight-x-face-function
149 (point-min) (re-search-forward mail-header-separator nil t)))
150 (setq mode-line-process (concat ":" wl-template))
151 (set-buffer-modified-p nil))))
153 (defun wl-template-next ()
154 "Display next reference in other buffer."
156 (if (= wl-template-max-num
157 (setq wl-template-cur-num (1+ wl-template-cur-num)))
158 (setq wl-template-cur-num 0))
161 (defun wl-template-prev ()
162 "Display previous reference in other buffer."
164 (setq wl-template-cur-num (if (zerop wl-template-cur-num)
165 (1- wl-template-max-num)
166 (1- wl-template-cur-num)))
169 (defun wl-template-abort ()
170 "Exit from electric reference mode without inserting reference."
172 (setq wl-template nil)
174 (kill-buffer wl-template-buffer-name)
175 (when (buffer-live-p wl-template-draft-buffer)
176 (set-buffer wl-template-draft-buffer)
177 (let ((win (get-buffer-window wl-template-draft-buffer)))
178 (if win (select-window win)))))
180 (defun wl-template-set ()
181 "Exit from electric reference mode and insert selected reference."
183 (if (and wl-template-confirm
184 (not (y-or-n-p "Are you sure ? ")))
187 (kill-buffer wl-template-buffer-name)
188 (when (buffer-live-p wl-template-draft-buffer)
189 (set-buffer wl-template-draft-buffer)
190 (wl-template-apply wl-template)
191 (let ((win (get-buffer-window wl-template-draft-buffer)))
192 (if win (select-window win))))))
194 (defun wl-template-insert (name &optional mail-header)
195 "Insert NAME template.
196 Set header-separator is MAIL-HEADER."
197 (let ((template (cdr (assoc name wl-template-alist)))
198 (mail-header-separator (or mail-header
199 mail-header-separator)))
202 (insert mail-header-separator "\n"))
203 (wl-draft-config-exec-sub template))))
206 (product-provide (provide 'wl-template) (require 'wl-version))
208 ;;; wl-template.el ends here