wl/wl-template.el

   1 ;;; wl-template.el --- Draft template feature for Wanderlust.
   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
  34 ;; Variables
  35
  36 (defvar wl-template-default-name "default")
  37 (defvar wl-template-buffer-name "*WL-Template*")
  38 (defvar wl-template-mode-map nil)
  39
  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)
  45
  46 ;;; Code
  47
  48 (if wl-template-mode-map
  49     nil
  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))
  56
  57 (defun wl-template-preview-p ()
  58   "Return non-nil when preview template."
  59   wl-template-preview)
  60
  61 (defun wl-template-apply (name)
  62   "Apply NAME template to draft."
  63   (let (template)
  64     (when name
  65       (if (string= name "")
  66           (setq name wl-template-default-name))
  67       (when (setq template (cdr (assoc name wl-template-alist)))
  68         (save-excursion
  69           (setq wl-draft-config-variables
  70                 (elmo-uniq-list
  71                  (nconc wl-draft-config-variables
  72                         (save-excursion
  73                           (wl-draft-config-exec-sub template)))))
  74           ;; rehighlight
  75           (if wl-highlight-body-too
  76               (let ((beg (point-min))
  77                     (end (point-max)))
  78                 (put-text-property beg end 'face nil)
  79                 (wl-highlight-message beg end t))))))))
  80
  81 (defun wl-template-mode ()
  82   "Major mode for Wanderlust template.
  83 See info under Wanderlust for full documentation.
  84
  85 \\{wl-template-mode}
  86
  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))
  94
  95 (defun wl-template-select (&optional arg)
  96   "Select template from `wl-template-alist'."
  97   (interactive "P")
  98   (unless wl-template-alist
  99     (error "Please set `wl-template-alist'"))
 100   (if (not (if arg
 101                (not wl-template-visible-select)
 102              wl-template-visible-select))
 103       (wl-template-apply
 104        (completing-read (format "Template (%s): " wl-template-default-name)
 105                         wl-template-alist))
 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))
 119                (size (min
 120                       (- (window-height cur-win)
 121                          window-min-height 1)
 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)
 132       (wl-template-mode)
 133       (wl-template-show))))
 134
 135 (defun wl-template-show (&optional arg)
 136   "Show reference INDEX in `wl-template-alist'.
 137 ARG is ignored."                        ; ARG ignored this version (?)
 138   (with-current-buffer wl-template-buffer-name
 139     (let ((buffer-read-only nil)
 140           (wl-template-preview t)
 141           (mail-header-separator  "--header separater--"))
 142       (erase-buffer)
 143       (goto-char (point-min))
 144       (wl-template-insert
 145        (setq wl-template (car (nth wl-template-cur-num wl-template-alist)))
 146        mail-header-separator)
 147       (wl-highlight-message (point-min) (point-max) t)
 148       (when wl-highlight-x-face-function
 149         (funcall wl-highlight-x-face-function
 150                  (point-min) (re-search-forward mail-header-separator nil t)))
 151       (setq mode-line-process (concat ":" wl-template))
 152       (set-buffer-modified-p nil))))
 153
 154 (defun wl-template-next ()
 155   "Display next reference in other buffer."
 156   (interactive)
 157   (if (= wl-template-max-num
 158          (setq wl-template-cur-num (1+ wl-template-cur-num)))
 159       (setq wl-template-cur-num 0))
 160   (wl-template-show))
 161
 162 (defun wl-template-prev ()
 163   "Display previous reference in other buffer."
 164   (interactive)
 165   (setq wl-template-cur-num (if (zerop wl-template-cur-num)
 166                                 (1- wl-template-max-num)
 167                               (1- wl-template-cur-num)))
 168   (wl-template-show))
 169
 170 (defun wl-template-abort ()
 171   "Exit from electric reference mode without inserting reference."
 172   (interactive)
 173   (setq wl-template nil)
 174   (delete-window)
 175   (kill-buffer wl-template-buffer-name)
 176   (when (buffer-live-p wl-template-draft-buffer)
 177     (set-buffer wl-template-draft-buffer)
 178     (let ((win (get-buffer-window wl-template-draft-buffer)))
 179       (if win (select-window win)))))
 180
 181 (defun wl-template-set ()
 182   "Exit from electric reference mode and insert selected reference."
 183   (interactive)
 184   (if (and wl-template-confirm
 185            (not (y-or-n-p "Are you sure ? ")))
 186       (message "")
 187     (delete-window)
 188     (kill-buffer wl-template-buffer-name)
 189     (when (buffer-live-p wl-template-draft-buffer)
 190       (set-buffer wl-template-draft-buffer)
 191       (wl-template-apply wl-template)
 192       (let ((win (get-buffer-window wl-template-draft-buffer)))
 193         (if win (select-window win))))))
 194
 195 (defun wl-template-insert (name &optional mail-header)
 196   "Insert NAME template.
 197 Set header-separator is MAIL-HEADER."
 198   (let ((template (cdr (assoc name wl-template-alist)))
 199         (mail-header-separator (or mail-header
 200                                    mail-header-separator)))
 201     (when template
 202       (if mail-header
 203           (insert mail-header-separator "\n"))
 204       (wl-draft-config-exec-sub template))))
 205
 206 (require 'product)
 207 (product-provide (provide 'wl-template) (require 'wl-version))
 208
 209 ;;; wl-template.el ends here