summaryrefslogtreecommitdiff
path: root/message-templ.el
diff options
context:
space:
mode:
authorDavid Bremner <bremner@unb.ca>2009-12-28 13:37:57 -0400
committerDavid Bremner <bremner@unb.ca>2009-12-29 21:42:22 -0400
commit3b4328ab150f4425ebe94907273cf1957c494349 (patch)
treed801c576701e770b9d20ba81c0af4363f8656bbb /message-templ.el
Initial version, from http://nijino.homelinux.net/emacs/message-templ.el
on 2009-12-28
Diffstat (limited to 'message-templ.el')
-rw-r--r--message-templ.el353
1 files changed, 353 insertions, 0 deletions
diff --git a/message-templ.el b/message-templ.el
new file mode 100644
index 0000000..333d8ac
--- /dev/null
+++ b/message-templ.el
@@ -0,0 +1,353 @@
+;;; message-templ.el --- Template feature for message.
+
+;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 2004 ARISAWA Akihiro <ari@mbf.sphere.ne.jp>
+
+;; Author: ARISAWA Akihiro <ari@mbf.sphere.ne.jp>
+;; Keywords: mail, news, template
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+
+;; Original codes are wl-template.el and wl-draft.el.
+
+;;; Code:
+
+(require 'message)
+(autoload 'article-display-x-face "gnus-art" nil t)
+
+(defgroup message-temp nil
+ "Template for message composing."
+ :group 'message)
+
+(defcustom message-templ-alist nil
+ "Alist of template.
+First element of each list is a string specifies the name of the template.
+Remaining elements indicate actions."
+ :type '(repeat (list (string :tag "Name")
+ (repeat
+ :inline t
+ (choice (cons (sexp :tag "Field(Variable)")
+ (sexp :tag "Value"))
+ (sexp :tag "Function")))))
+ :group 'message-templ)
+
+(defcustom message-templ-visible-select t
+ "*If non-nil, select template with visible."
+ :type 'boolean
+ :group 'message-templ)
+
+(defcustom message-templ-confirm nil
+ "*If non-nil, require your confirmation when selected template."
+ :type 'boolean
+ :group 'message-templ)
+
+(defcustom message-templ-buffer-lines 7
+ "*Lines of template buffer."
+ :type 'integer
+ :group 'message-templ)
+
+(defvar message-templ-default-name "default")
+(defvar message-templ-buffer-name "*Message-Template*")
+(defvar message-templ-mode-map nil)
+
+(defvar message-templ nil)
+(defvar message-templ-cur-num 0)
+(defvar message-templ-max-num 0)
+(defvar message-templ-draft-buffer nil)
+(defvar message-templ-preview nil)
+(defvar message-templ-config-variables nil)
+
+(defvar message-templ-config-sub-function-alist
+ '((body . message-templ-config-sub-body)
+ (top . message-templ-config-sub-top)
+ (bottom . message-templ-config-sub-bottom)
+ (header . message-templ-config-sub-header)
+ (header-top . message-templ-config-sub-header-top)
+ (header-bottom . message-templ-config-sub-header)
+; (part-top . message-templ-config-sub-part-top)
+; (part-bottom . message-templ-config-sub-part-bottom)
+ (body-file . message-templ-config-sub-body-file)
+ (top-file . message-templ-config-sub-top-file)
+ (bottom-file . message-templ-config-sub-bottom-file)
+ (header-file . message-templ-config-sub-header-file)
+ (template . message-templ-config-sub-template)
+ (x-face . message-templ-config-sub-x-face)))
+
+(unless message-templ-mode-map
+ (setq message-templ-mode-map (make-sparse-keymap))
+ (define-key message-templ-mode-map "p" 'message-templ-prev)
+ (define-key message-templ-mode-map "n" 'message-templ-next)
+ (define-key message-templ-mode-map "q" 'message-templ-abort)
+ (define-key message-templ-mode-map "\r" 'message-templ-set)
+ (define-key message-templ-mode-map "\n" 'message-templ-set))
+
+(defsubst message-templ-config-sub-eval-insert (content &optional newline)
+ (let (content-value)
+ (when (and content
+ (stringp (setq content-value (eval content))))
+ (insert content-value)
+ (when newline (insert "\n")))))
+
+(defun message-templ-config-sub-body (content)
+ (message-goto-body)
+ (delete-region (point) (point-max))
+ (message-templ-config-sub-eval-insert content))
+
+(defun message-templ-config-sub-top (content)
+ (message-goto-body)
+ (message-templ-config-sub-eval-insert content))
+
+(defun message-templ-config-sub-bottom (content)
+ (goto-char (point-max))
+ (message-templ-config-sub-eval-insert content))
+
+(defun message-templ-config-sub-header (content)
+ (message-goto-eoh)
+ (message-templ-config-sub-eval-insert content 'newline))
+
+(defun message-templ-config-sub-header-top (content)
+ (goto-char (point-min))
+ (message-templ-config-sub-eval-insert content 'newline))
+
+;(defun message-templ-config-sub-part-top (content)
+; (goto-char (mime-edit-content-beginning))
+; (message-templ-config-sub-eval-insert content 'newline))
+
+;(defun message-templ-config-sub-part-bottom (content)
+; (goto-char (mime-edit-content-end))
+; (message-templ-config-sub-eval-insert content 'newline))
+
+(defsubst message-templ-config-sub-file (content)
+ (let ((coding-system-for-read 'undecided)
+ (file (expand-file-name (eval content))))
+ (if (file-exists-p file)
+ (insert-file-contents file)
+ (error "%s: no exists file" file))))
+
+(defun message-templ-config-sub-body-file (content)
+ (message-goto-body)
+ (delete-region (point) (point-max))
+ (message-templ-config-sub-file content))
+
+(defun message-templ-config-sub-top-file (content)
+ (message-goto-body)
+ (message-templ-config-sub-file content))
+
+(defun message-templ-config-sub-bottom-file (content)
+ (goto-char (point-max))
+ (message-templ-config-sub-file content))
+
+(defun message-templ-config-sub-header-file (content)
+ (message-goto-eoh)
+ (message-templ-config-sub-file content))
+
+(defun message-templ-config-sub-template (content)
+ (setq message-templ-config-variables
+ (message-templ-insert (eval content))))
+
+(defun message-templ-config-sub-x-face (content)
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "X-Face"))
+ (message-position-on-field "X-Face" "From")
+ (nnheader-insert-file-contents content))
+
+(defun message-templ-config-sub-function (field content)
+ (let (func)
+ (when (setq func (assq field message-templ-config-sub-function-alist))
+ (let (message-templ-config-variables)
+ (funcall (cdr func) content)
+ ;; for message-templ-config-sub-template
+ (cons t message-templ-config-variables)))))
+
+(defun messsage-templ-config-exec-sub (clist)
+ (let (config local-variables)
+ (while clist
+ (setq config (car clist))
+ (cond
+ ((functionp config)
+ (funcall config))
+ ((consp config)
+ (let ((field (car config))
+ (content (cdr config))
+ ret-val)
+ (cond
+ ((stringp field)
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header field))
+ (message-position-on-field field)
+ (insert (eval content)))
+ ((setq ret-val (message-templ-config-sub-function field content))
+ (when (cdr ret-val) ;; for message-templ-config-sub-template
+ (setq local-variables (nconc local-variables (cdr ret-val)))))
+ ((boundp field) ;; variable
+ (make-local-variable field)
+ (set field (eval content))
+ (setq local-variables (nconc local-variables (list field))))
+ (t
+ (error "%s: not variable" field)))))
+ (t
+ (error "%s: not supported type" config)))
+ (setq clist (cdr clist)))
+ local-variables))
+
+(defun message-templ-preview-p ()
+ "Return non-nil when preview template."
+ message-templ-preview)
+
+(defun message-templ-apply (name)
+ "Apply NAME template to draft."
+ (let (template)
+ (when name
+ (when (string= name "")
+ (setq name message-templ-default-name))
+ (when (setq template (cdr (assoc name message-templ-alist)))
+ (save-excursion
+ (messsage-templ-config-exec-sub template))))))
+
+(defun message-templ-mode ()
+ "Major mode for message template.
+
+\\{message-templ-mode}
+
+Entering Message-Templ mode calls the value of `message-templ-mode-hook'."
+ (kill-all-local-variables)
+ (setq mode-name "Message-Templ"
+ major-mode 'message-templ-mode)
+ (use-local-map message-templ-mode-map)
+ (set (make-local-variable 'font-lock-defaults)
+ '(message-font-lock-keywords t))
+ (setq buffer-read-only t)
+ (run-hooks 'message-templ-mode-hook))
+
+(defun message-templ-select (&optional arg)
+ "Select template from `message-templ-alist'."
+ (interactive "P")
+ (if (not (if arg
+ (not message-templ-visible-select)
+ message-templ-visible-select))
+ (message-templ-apply
+ (completing-read (format "Template (%s): " message-templ-default-name)
+ message-templ-alist))
+ (let* ((begin message-templ-default-name)
+ (work message-templ-alist))
+ (when (and begin (cdr (assoc begin message-templ-alist)))
+ (while (not (string= (car (car work)) begin))
+ (setq message-templ-cur-num (1+ message-templ-cur-num))
+ (setq work (cdr work))))
+ (setq message-templ nil
+ message-templ-cur-num 0
+ message-templ-max-num (length message-templ-alist))
+ (setq message-templ-draft-buffer (current-buffer))
+ (if (get-buffer-window message-templ-buffer-name)
+ (select-window (get-buffer-window message-templ-buffer-name))
+ (let* ((cur-win (selected-window))
+ (size (min
+ (- (window-height cur-win)
+ window-min-height 1)
+ (- (window-height cur-win)
+ (max window-min-height
+ (1+ message-templ-buffer-lines))))))
+ (split-window cur-win (if (> size 0) size window-min-height))
+ ;; goto the bottom of the two...
+ (select-window (next-window))
+ ;; make it display...
+ (let ((pop-up-windows nil))
+ (switch-to-buffer (get-buffer-create message-templ-buffer-name)))))
+ (set-buffer message-templ-buffer-name)
+ (message-templ-mode)
+ (message-templ-show))))
+
+(defun message-templ-show (&optional arg)
+ "Show reference INDEX in `message-templ-alist'.
+vARG is ignored." ; ARG ignored this version (?)
+ (save-excursion
+ (set-buffer message-templ-buffer-name)
+ (let ((buffer-read-only nil)
+ (message-templ-preview t)
+ (mail-header-separator "--header separater--"))
+ (erase-buffer)
+ (goto-char (point-min))
+ (message-templ-insert
+ (setq message-templ
+ (car (nth message-templ-cur-num message-templ-alist)))
+ mail-header-separator)
+ (let ((gnus-article-buffer (current-buffer)))
+ (article-display-x-face))
+ (setq mode-line-process (concat ":" message-templ))
+ (set-buffer-modified-p nil))))
+
+(defun message-templ-next ()
+ "Display next reference in other buffer."
+ (interactive)
+ (when (= message-templ-max-num
+ (setq message-templ-cur-num (1+ message-templ-cur-num)))
+ (setq message-templ-cur-num 0))
+ (message-templ-show))
+
+(defun message-templ-prev ()
+ "Display previous reference in other buffer."
+ (interactive)
+ (setq message-templ-cur-num (if (zerop message-templ-cur-num)
+ (1- message-templ-max-num)
+ (1- message-templ-cur-num)))
+ (message-templ-show))
+
+(defun message-templ-abort ()
+ "Exit from electric reference mode without inserting reference."
+ (interactive)
+ (setq message-templ nil)
+ (delete-window)
+ (kill-buffer message-templ-buffer-name)
+ (when (buffer-live-p message-templ-draft-buffer)
+ (set-buffer message-templ-draft-buffer)
+ (let ((win (get-buffer-window message-templ-draft-buffer)))
+ (when win (select-window win)))))
+
+(defun message-templ-set ()
+ "Exit from electric reference mode and insert selected reference."
+ (interactive)
+ (if (and message-templ-confirm
+ (not (y-or-n-p "Are you sure ? ")))
+ (message "")
+ (delete-window)
+ (kill-buffer message-templ-buffer-name)
+ (when (buffer-live-p message-templ-draft-buffer)
+ (set-buffer message-templ-draft-buffer)
+ (message-templ-apply message-templ)
+ (let ((win (get-buffer-window message-templ-draft-buffer)))
+ (when win (select-window win))))))
+
+(defun message-templ-insert (name &optional mail-header)
+ "Insert NAME template.
+Set header-separator is MAIL-HEADER."
+ (let ((template (cdr (assoc name message-templ-alist)))
+ (mail-header-separator (or mail-header
+ mail-header-separator)))
+ (when template
+ (when mail-header
+ (insert mail-header-separator "\n"))
+ (messsage-templ-config-exec-sub template))))
+
+(provide 'message-templ)
+;;; message-templ.el ends here