1;;; wl-template.el --- Draft template feature for Wanderlust.  -*- lexical-binding: t -*-
2
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>
5
6;; Author: Masahiro MURATA <muse@ba2.so-net.ne.jp>
7;; Keywords: mail, net news
8
9;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
10
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)
14;; any later version.
15;;
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.
20;;
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.
25;;
26
27;;; Commentary:
28
29;;; Code:
30;;
31(require 'elmo-util)
32(require 'wl-vars)
33(require 'wl-highlight)
34
35(provide 'wl-template)
36
37;; Variables
38
39(defvar wl-template-default-name "default")
40(defvar wl-template-buffer-name "*WL-Template*")
41(defvar wl-template-mode-map nil)
42
43(defvar wl-template nil)
44(defvar wl-template-cur-num 0)
45(defvar wl-template-max-num 0)
46(defvar wl-template-draft-buffer nil)
47(defvar wl-template-preview nil)
48
49;;; Code
50
51(if wl-template-mode-map
52    nil
53  (setq wl-template-mode-map (make-sparse-keymap))
54  (define-key wl-template-mode-map "p"     'wl-template-prev)
55  (define-key wl-template-mode-map "n"     'wl-template-next)
56  (define-key wl-template-mode-map "q"     'wl-template-abort)
57  (define-key wl-template-mode-map "\r"    'wl-template-set)
58  (define-key wl-template-mode-map "\n"    'wl-template-set))
59
60(defun wl-template-preview-p ()
61  "Return non-nil when preview template."
62  wl-template-preview)
63
64(defun wl-template-mode ()
65  "Major mode for Wanderlust template.
66See info under Wanderlust for full documentation.
67
68\\{wl-template-mode}
69
70Entering WL-Template mode calls the value of `wl-template-mode-hook'."
71  (kill-all-local-variables)
72  (setq mode-name "Wl-Template"
73	major-mode 'wl-template-mode)
74  (use-local-map wl-template-mode-map)
75  (setq buffer-read-only t)
76  (run-hooks 'wl-template-mode-hook))
77
78(defun wl-template-select (&optional arg)
79  "Select template from `wl-template-alist'."
80  (interactive "P")
81  (unless wl-template-alist
82    (error "Please set `wl-template-alist'"))
83  (if (not (if arg
84	       (not wl-template-visible-select)
85	     wl-template-visible-select))
86      (wl-template-apply
87       (completing-read (format "Template (%s): " wl-template-default-name)
88			wl-template-alist))
89    (let* ((begin wl-template-default-name)
90	   (work wl-template-alist))
91      (if (and begin (cdr (assoc begin wl-template-alist)))
92	  (while (not (string= (car (car work)) begin))
93	    (setq wl-template-cur-num (1+ wl-template-cur-num))
94	    (setq work (cdr work))))
95      (setq wl-template nil
96	    wl-template-cur-num 0
97	    wl-template-max-num (length wl-template-alist))
98      (setq wl-template-draft-buffer (current-buffer))
99      (if (get-buffer-window wl-template-buffer-name)
100	  (select-window (get-buffer-window wl-template-buffer-name))
101	(let* ((cur-win (selected-window))
102	       (size (min
103		      (- (window-height cur-win)
104			 window-min-height 1)
105		      (- (window-height cur-win)
106			 (max window-min-height
107			      (1+ wl-template-buffer-lines))))))
108	  (split-window cur-win (if (> size 0) size window-min-height))
109	  ;; goto the bottom of the two...
110	  (select-window (next-window))
111	  ;; make it display...
112	  (let ((pop-up-windows nil))
113	    (switch-to-buffer (get-buffer-create wl-template-buffer-name)))))
114      (set-buffer wl-template-buffer-name)
115      (wl-template-mode)
116      (wl-template-show))))
117
118(defun wl-template-show (&optional _arg)
119  "Show reference INDEX in `wl-template-alist'.
120ARG is ignored."			; ARG ignored this version (?)
121  (with-current-buffer wl-template-buffer-name
122    (let ((buffer-read-only nil)
123	  (wl-template-preview t)
124	  (mail-header-separator  "--header separator--"))
125      (erase-buffer)
126      (goto-char (point-min))
127      (wl-template-insert
128       (setq wl-template (car (nth wl-template-cur-num wl-template-alist)))
129       mail-header-separator)
130      (wl-highlight-message (point-min) (point-max) t)
131      (when wl-highlight-x-face-function
132	(funcall wl-highlight-x-face-function
133		 (point-min) (re-search-forward mail-header-separator nil t)))
134      (setq mode-line-process (concat ":" wl-template))
135      (set-buffer-modified-p nil))))
136
137(defun wl-template-next ()
138  "Display next reference in other buffer."
139  (interactive)
140  (if (= wl-template-max-num
141	 (setq wl-template-cur-num (1+ wl-template-cur-num)))
142      (setq wl-template-cur-num 0))
143  (wl-template-show))
144
145(defun wl-template-prev ()
146  "Display previous reference in other buffer."
147  (interactive)
148  (setq wl-template-cur-num (if (zerop wl-template-cur-num)
149				(1- wl-template-max-num)
150			      (1- wl-template-cur-num)))
151  (wl-template-show))
152
153(defun wl-template-insert (name &optional mail-header)
154  "Insert NAME template.
155Set header-separator is MAIL-HEADER."
156  (let ((template (cdr (assoc name wl-template-alist)))
157	(mail-header-separator (or mail-header
158				   mail-header-separator)))
159    (when template
160      (if mail-header
161	  (insert mail-header-separator "\n"))
162      (wl-draft-config-exec-sub template))))
163
164(require 'wl-draft)
165
166(defun wl-template-apply (name)
167  "Apply NAME template to draft."
168  (let (template wl-draft-real-time-highlight)
169    (when name
170      (if (string= name "")
171	  (setq name wl-template-default-name))
172      (when (setq template (cdr (assoc name wl-template-alist)))
173	(save-excursion
174	  (setq wl-draft-config-variables
175		(elmo-uniq-list
176		 (nconc wl-draft-config-variables
177			(save-excursion
178			  (wl-draft-config-exec-sub template)))))
179	  ;; rehighlight
180	  (if wl-highlight-body-too
181	      (let ((beg (point-min))
182		    (end (point-max)))
183		(put-text-property beg end 'face nil)
184		(wl-highlight-message beg end t))))))))
185
186(defun wl-template-abort ()
187  "Exit from electric reference mode without inserting reference."
188  (interactive)
189  (setq wl-template nil)
190  (delete-window)
191  (kill-buffer wl-template-buffer-name)
192  (when (buffer-live-p wl-template-draft-buffer)
193    (set-buffer wl-template-draft-buffer)
194    (let ((win (get-buffer-window wl-template-draft-buffer)))
195      (if win (select-window win)))))
196
197(defun wl-template-set ()
198  "Exit from electric reference mode and insert selected reference."
199  (interactive)
200  (if (and wl-template-confirm
201	   (not (y-or-n-p "Are you sure ? ")))
202      (message "")
203    (delete-window)
204    (kill-buffer wl-template-buffer-name)
205    (when (buffer-live-p wl-template-draft-buffer)
206      (set-buffer wl-template-draft-buffer)
207      (wl-template-apply wl-template)
208      (let ((win (get-buffer-window wl-template-draft-buffer)))
209	(if win (select-window win))))))
210
211(require 'product)
212(product-provide (provide 'wl-template) (require 'wl-version))
213
214;;; wl-template.el ends here
215