admin/JMpost-wl.el

   1 ;; -*- mode: emacs-lisp -*-
   2 ;;
   3 ;; JMpost-wl.el -- JMpost フォーマットのメールを作成する
   4 ;;
   5 ;; Copyright (C) 1999-2001 Akihiro MOTOKI <motoki@dd.iij4u.or.jp>
   6 ;;
   7 ;; [準備]
   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 を設定する(オプション)。
  12 ;;
  13 ;; [使用方法]
  14 ;; (1) Goto to Wanderlust draft.
  15 ;; (2) M-x JMpost-wl
  16 ;;
  17 ;;
  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)
  21 ;; any later version.
  22 ;;
  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.
  27 ;;
  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.
  32
  33 (defvar JMpost-wl-status-list '("TR" "DO" "DP" "PR" "RO" "RR"))
  34 (defvar JMpost-wl-default-status "DP")
  35
  36 (defvar JMpost-wl-post-address "linuxjm-discuss@lists.sourceforge.jp"
  37   "*JM の作業メールの送信先")
  38
  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.")
  43
  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)
  50
  51 (defun JMpost-wl (&optional FILENAME)
  52   (interactive)
  53   (if (not (eq major-mode 'wl-draft-mode))
  54       (error "Run in wl-draft mode!"))
  55   (let ((filename
  56          (or FILENAME
  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
  63                         (format
  64                          "%s/?\\(.+\\)/\\(draft\\|release\\)/man[1-9]/"
  65                          JMpost-wl-manual-directory)))
  66         manpage dirname pkgname pkgread)
  67     ;; Check filename
  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)))
  75     ;; Package name
  76     (setq pkgread (read-from-minibuffer
  77                    (if pkgname (format "Package (%s): " pkgname) "Package: ")))
  78     (if (not (string= pkgread ""))
  79         (setq pkgname pkgread))
  80     (if (null pkgname)
  81         (error "Please specify PACKAGE NAME.")
  82     ;; Field insert
  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)
  97                     "</STATUS>\n\n"))
  98     (if (or (string= status "TR") (string= status "PR"))
  99         ()
 100       (insert-file-contents filename))
 101     (setq wl-draft-config-exec-flag nil)
 102     (wl-highlight-headers))
 103     ))
 104
 105 (provide 'JMpost-wl)