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.
36 (defvar wl-template-default-name
"default")
37 (defvar wl-template-buffer-name
"*WL-Template*")
38 (defvar wl-template-mode-map nil
)
40 (defvar wl-template nil
)
41 (defvar wl-template-cur-num
0)
42 (defvar wl-template-max-num
0)
43 (defvar wl-template-draft-buffer nil
)
44 (defvar wl-template-preview nil
)
48 (if wl-template-mode-map
50 (setq wl-template-mode-map
(make-sparse-keymap))
51 (define-key wl-template-mode-map
"p" 'wl-template-prev
)
52 (define-key wl-template-mode-map
"n" 'wl-template-next
)
53 (define-key wl-template-mode-map
"q" 'wl-template-abort
)
54 (define-key wl-template-mode-map
"\r" 'wl-template-set
)
55 (define-key wl-template-mode-map
"\n" 'wl-template-set
))
57 (defun wl-template-preview-p ()
58 "Return non-nil when preview template."
61 (defun wl-template-apply (name)
62 "Apply NAME template to draft."
66 (setq name wl-template-default-name
))
67 (when (setq template
(cdr (assoc name wl-template-alist
)))
69 (setq wl-draft-config-variables
71 (nconc wl-draft-config-variables
73 (wl-draft-config-exec-sub template
)))))
75 (if wl-highlight-body-too
76 (let ((beg (point-min))
78 (put-text-property beg end
'face nil
)
79 (wl-highlight-message beg end t
))))))))
81 (defun wl-template-mode ()
82 "Major mode for Wanderlust template.
83 See info under Wanderlust for full documentation.
87 Entering WL-Template mode calls the value of `wl-template-mode-hook'."
88 (kill-all-local-variables)
89 (setq mode-name
"Wl-Template"
90 major-mode
'wl-template-mode
)
91 (use-local-map wl-template-mode-map
)
92 (setq buffer-read-only t
)
93 (run-hooks 'wl-template-mode-hook
))
95 (defun wl-template-select (&optional arg
)
96 "Select template from `wl-template-alist'."
98 (unless wl-template-alist
99 (error "Please set `wl-template-alist'"))
101 (not wl-template-visible-select
)
102 wl-template-visible-select
))
104 (completing-read (format "Template (%s): " wl-template-default-name
)
106 (let* ((begin wl-template-default-name
)
107 (work wl-template-alist
))
108 (if (and begin
(cdr (assoc begin wl-template-alist
)))
109 (while (not (string= (car (car work
)) begin
))
110 (setq wl-template-cur-num
(1+ wl-template-cur-num
))
111 (setq work
(cdr work
))))
112 (setq wl-template nil
113 wl-template-cur-num
0
114 wl-template-max-num
(length wl-template-alist
))
115 (setq wl-template-draft-buffer
(current-buffer))
116 (if (get-buffer-window wl-template-buffer-name
)
117 (select-window (get-buffer-window wl-template-buffer-name
))
118 (let* ((cur-win (selected-window))
120 (- (window-height cur-win
)
122 (- (window-height cur-win
)
123 (max window-min-height
124 (1+ wl-template-buffer-lines
))))))
125 (split-window cur-win
(if (> size
0) size window-min-height
))
126 ;; goto the bottom of the two...
127 (select-window (next-window))
128 ;; make it display...
129 (let ((pop-up-windows nil
))
130 (switch-to-buffer (get-buffer-create wl-template-buffer-name
)))))
131 (set-buffer wl-template-buffer-name
)
133 (wl-template-show))))
135 (defun wl-template-show (&optional arg
)
136 "Show reference INDEX in `wl-template-alist'.
137 ARG is ignored." ; ARG ignored this version (?)
139 (set-buffer wl-template-buffer-name
)
140 (let ((buffer-read-only nil
)
141 (wl-template-preview t
)
142 (mail-header-separator "--header separater--"))
144 (goto-char (point-min))
146 (setq wl-template
(car (nth wl-template-cur-num wl-template-alist
)))
147 mail-header-separator
)
148 (wl-highlight-message (point-min) (point-max) t
)
149 (when wl-highlight-x-face-function
150 (funcall wl-highlight-x-face-function
151 (point-min) (re-search-forward mail-header-separator nil t
)))
152 (setq mode-line-process
(concat ":" wl-template
))
153 (set-buffer-modified-p nil
))))
155 (defun wl-template-next ()
156 "Display next reference in other buffer."
158 (if (= wl-template-max-num
159 (setq wl-template-cur-num
(1+ wl-template-cur-num
)))
160 (setq wl-template-cur-num
0))
163 (defun wl-template-prev ()
164 "Display previous reference in other buffer."
166 (setq wl-template-cur-num
(if (zerop wl-template-cur-num
)
167 (1- wl-template-max-num
)
168 (1- wl-template-cur-num
)))
171 (defun wl-template-abort ()
172 "Exit from electric reference mode without inserting reference."
174 (setq wl-template nil
)
176 (kill-buffer wl-template-buffer-name
)
177 (when (buffer-live-p wl-template-draft-buffer
)
178 (set-buffer wl-template-draft-buffer
)
179 (let ((win (get-buffer-window wl-template-draft-buffer
)))
180 (if win
(select-window win
)))))
182 (defun wl-template-set ()
183 "Exit from electric reference mode and insert selected reference."
185 (if (and wl-template-confirm
186 (not (y-or-n-p "Are you sure ? ")))
189 (kill-buffer wl-template-buffer-name
)
190 (when (buffer-live-p wl-template-draft-buffer
)
191 (set-buffer wl-template-draft-buffer
)
192 (wl-template-apply wl-template
)
193 (let ((win (get-buffer-window wl-template-draft-buffer
)))
194 (if win
(select-window win
))))))
196 (defun wl-template-insert (name &optional mail-header
)
197 "Insert NAME template.
198 Set header-separator is MAIL-HEADER."
199 (let ((template (cdr (assoc name wl-template-alist
)))
200 (mail-header-separator (or mail-header
201 mail-header-separator
)))
204 (insert mail-header-separator
"\n"))
205 (wl-draft-config-exec-sub template
))))
208 (product-provide (provide 'wl-template
) (require 'wl-version
))
210 ;;; wl-template.el ends here