wl/wl-template.el

   1 ;;; wl-template.el -- Draft template feature for Wanderlust.
   2
   3 ;; Copyright 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
   4 ;;                          Yuuichi Teranishi <teranisi@gohome.org>
   5
   6 ;; Author: Masahiro MURATA <muse@ba2.so-net.ne.jp>
   7 ;; Keywords: mail, net news
   8 ;; Time-stamp: <2000-03-03 13:18:35 teranisi>
   9
  10 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26 ;;
  27
  28 ;;; Commentary:
  29
  30 ;;; Code:
  31 ;;
  32
  33 ;; Variables
  34
  35 (defvar wl-template-default-name "default")
  36 (defvar wl-template-buffer-name "*WL-Template*")
  37 (defvar wl-template-mode-map nil)
  38
  39 (defvar wl-template nil)
  40 (defvar wl-template-cur-num 0)
  41 (defvar wl-template-max-num 0)
  42 (defvar wl-template-draft-buffer nil)
  43
  44 ;;; Code
  45
  46 (if wl-template-mode-map
  47     nil
  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))
  54
  55 (defun wl-template-apply (name)
  56   (let (template)
  57     (when name
  58       (if (string= name "")
  59           (setq name wl-template-default-name))
  60       (when (setq template (cdr (assoc name wl-template-alist)))
  61         (save-excursion
  62           (setq wl-draft-config-variables
  63                 (elmo-uniq-list
  64                  (nconc wl-draft-config-variables
  65                         (save-excursion
  66                           (wl-draft-config-exec-sub template)))))
  67           ;; rehighlight
  68           (if wl-highlight-body-too
  69               (let ((beg (point-min))
  70                     (end (point-max)))
  71                 (put-text-property beg end 'face nil)
  72                 (wl-highlight-message beg end t))))))))
  73
  74 (defun wl-template-mode ()
  75   "Major mode for Wanderlust template.
  76 See info under Wanderlust for full documentation.
  77
  78 \\{wl-template-mode}
  79
  80 Enterring WL-Template mode calls the value of `wl-template-mode-hook'."
  81   (kill-all-local-variables)
  82   (setq mode-name "Wl-Template"
  83         major-mode 'wl-template-mode)
  84   (use-local-map wl-template-mode-map)
  85   (setq buffer-read-only t)
  86   (run-hooks 'wl-template-mode-hook))
  87
  88 (defun wl-template-select ()
  89   (interactive)
  90   (if (not wl-template-visible-select)
  91       (wl-template-apply
  92        (completing-read (format "Template (%s): " wl-template-default-name)
  93                         wl-template-alist))
  94     (let* ((begin wl-template-default-name)
  95            (work wl-template-alist))
  96       (if (and begin (cdr (assoc begin wl-template-alist)))
  97           (while (not (string= (car (car work)) begin))
  98             (setq wl-template-cur-num (1+ wl-template-cur-num))
  99             (setq work (cdr work))))
 100       (setq wl-template nil
 101             wl-template-cur-num 0
 102             wl-template-max-num (length wl-template-alist))
 103       (setq wl-template-draft-buffer (current-buffer))
 104       (if (get-buffer-window wl-template-buffer-name)
 105           (select-window (get-buffer-window wl-template-buffer-name))
 106         (let* ((cur-win (selected-window))
 107                (size (min
 108                       (- (window-height cur-win)
 109                          window-min-height 1)
 110                       (- (window-height cur-win)
 111                          (max window-min-height
 112                               (1+ wl-template-buffer-lines))))))
 113           (split-window cur-win (if (> size 0) size window-min-height))
 114           ;; goto the bottom of the two...
 115           (select-window (next-window))
 116           ;; make it display...
 117           (let ((pop-up-windows nil))
 118             (switch-to-buffer (get-buffer-create wl-template-buffer-name)))))
 119       (set-buffer wl-template-buffer-name)
 120       (wl-template-mode)
 121       (wl-template-show))))
 122
 123 (defun wl-template-show (&optional arg)
 124   "Show reference INDEX in wl-template-alist."
 125   (save-excursion
 126     (set-buffer wl-template-buffer-name)
 127     (let ((buffer-read-only nil)
 128           (mail-header-separator  "--header separater--"))
 129       (erase-buffer)
 130       (goto-char (point-min))
 131       (wl-template-insert
 132        (setq wl-template (car (nth wl-template-cur-num wl-template-alist)))
 133        mail-header-separator)
 134       (wl-highlight-message (point-min) (point-max) t)
 135       (and wl-highlight-x-face-func
 136            (funcall
 137             wl-highlight-x-face-func
 138             (point-min) (re-search-forward mail-header-separator nil t)))
 139       (setq mode-line-process (concat ":" wl-template))
 140       (set-buffer-modified-p nil))))
 141
 142 (defun wl-template-next ()
 143   "Display next reference in other buffer."
 144   (interactive)
 145   (if (eq wl-template-max-num
 146           (setq wl-template-cur-num (1+ wl-template-cur-num)))
 147       (setq wl-template-cur-num 0))
 148   (wl-template-show))
 149
 150 (defun wl-template-prev ()
 151   "Display previous reference in other buffer."
 152   (interactive)
 153   (setq wl-template-cur-num (if (eq wl-template-cur-num 0)
 154                                 (1- wl-template-max-num)
 155                               (1- wl-template-cur-num)))
 156   (wl-template-show))
 157
 158 (defun wl-template-abort ()
 159   "Exit from electric reference mode without inserting reference."
 160   (interactive)
 161   (setq wl-template nil)
 162   (delete-window)
 163   (kill-buffer wl-template-buffer-name)
 164   (when (buffer-live-p wl-template-draft-buffer)
 165     (set-buffer wl-template-draft-buffer)
 166     (let ((win (get-buffer-window wl-template-draft-buffer)))
 167       (if win (select-window win)))))
 168
 169 (defun wl-template-set ()
 170   "Exit from electric reference mode and insert selected reference."
 171   (interactive)
 172   (if (and wl-template-confirm
 173            (not (y-or-n-p "Are you sure ? ")))
 174       (message "")
 175     (delete-window)
 176     (kill-buffer wl-template-buffer-name)
 177     (when (buffer-live-p wl-template-draft-buffer)
 178       (set-buffer wl-template-draft-buffer)
 179       (wl-template-apply wl-template)
 180       (let ((win (get-buffer-window wl-template-draft-buffer)))
 181         (if win (select-window win))))))
 182
 183 (defun wl-template-insert (name &optional mail-header)
 184   (let ((template (cdr (assoc name wl-template-alist)))
 185         (mail-header-separator (or mail-header
 186                                    mail-header-separator)))
 187     (when template
 188       (if mail-header
 189           (insert mail-header-separator "\n"))
 190       (wl-draft-config-exec-sub template))))
 191
 192 (provide 'wl-template)
 193
 194 ;;; wl-template.el ends here