admin/JMpost-mew.el

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