1 ;; -*- mode: emacs-lisp -*-
3 ;; JMpost-wl.el -- JMpost フォーマットのメールを作成する
5 ;; Copyright (C) 1999-2001 Akihiro MOTOKI <motoki@dd.iij4u.or.jp>
8 ;; (1) ~/.emacs に (require 'JMpost-wl) を追加
9 ;; (2) JMpost-wl-from-address, JMpost-wl-from-name を確認する
10 ;; (3) JM CVS Repository をチェックアウトしている場合は
11 ;; JMpost-wl-manual-directory を設定する(オプション)。
14 ;; (1) Goto to Wanderlust draft.
18 ;; This program is free software; you can redistribute it and/or modify
19 ;; it under the terms of the GNU General Public License as published by
20 ;; the Free Software Foundation; either version 2, or (at your option)
23 ;; This program is distributed in the hope that it will be useful,
24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
26 ;; GNU General Public License for more details.
28 ;; You should have received a copy of the GNU General Public License
29 ;; along with GNU Emacs; see the file COPYING. If not, write to the
30 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
31 ;; Boston, MA 02111-1307, USA.
33 (defvar JMpost-wl-status-list '("TR" "DO" "DP" "PR" "RO" "RR"))
34 (defvar JMpost-wl-default-status "DP")
36 (defvar JMpost-wl-post-address "linuxjm-discuss@lists.sourceforge.jp"
39 (defvar JMpost-wl-from-address user-mail-address
40 "*Full e-mail address of the poster.")
41 (defvar JMpost-wl-from-name user-full-name
42 "*The full name of the poster.")
44 (defvar JMpost-wl-manual-directory nil
45 "*JM のマニュアルが展開されているディレクトリ。ディレクトリが
46 JM CVS と同じフォルダ階層であれば、パッケージ名の推測を行ってくれる。
47 JM CVS Repository を $JMDIR に展開している場合には、
48 本変数に $JMDIR/manual を設定するとよい。")
49 (defvar JMpost-wl-last-read-directory JMpost-wl-manual-directory)
51 (defun JMpost-wl (&optional FILENAME)
53 (if (not (eq major-mode 'wl-draft-mode))
54 (error "Run in wl-draft mode!"))
57 (read-file-name "Filename: " JMpost-wl-last-read-directory)))
58 (status (completing-read
59 (format "Page status (%s): " JMpost-wl-default-status)
60 (mapcar 'list JMpost-wl-status-list)
61 nil t nil nil JMpost-wl-default-status))
62 (pkg-regex (and JMpost-wl-manual-directory
64 "%s/?\\(.+\\)/\\(draft\\|release\\)/man[1-9]/"
65 JMpost-wl-manual-directory)))
66 manpage dirname pkgname pkgread)
68 (if (file-directory-p filename)
69 (error "The specified file is a directory.")
70 (setq manpage (file-name-nondirectory filename))
71 (setq dirname (file-name-directory filename))
72 (setq JMpost-wl-last-read-directory dirname))
73 (if (and pkg-regex (string-match pkg-regex dirname))
74 (setq pkgname (match-string 1 dirname)))
76 (setq pkgread (read-from-minibuffer
77 (if pkgname (format "Package (%s): " pkgname) "Package: ")))
78 (if (not (string= pkgread ""))
79 (setq pkgname pkgread))
81 (error "Please specify PACKAGE NAME.")
83 (wl-draft-replace-field "To" JMpost-wl-post-address)
84 (wl-draft-replace-field "From" JMpost-wl-from-address)
85 (wl-draft-replace-field "Subject"
86 (format "[POST:%s] %s %s"
87 status (if pkgname pkgname "") manpage))
88 ;; Generate body header
89 (wl-draft-body-goto-top)
90 (insert (concat "<STATUS>\n"
91 (format "stat: %s\n" status)
92 (format "ppkg: %s\n" (if pkgname pkgname ""))
93 (format "page: %s\n" manpage)
94 (format "date: %s\n" (format-time-string "%Y/%m/%d"))
95 (format "mail: %s\n" JMpost-wl-from-address)
96 (format "name: %s\n" JMpost-wl-from-name)
98 (if (or (string= status "TR") (string= status "PR"))
100 (insert-file-contents filename))
101 (setq wl-draft-config-exec-flag nil)
102 (wl-highlight-headers))