admin/JM-man-view.el

   1 ;; -*- mode: emacs-lisp -*-
   2 ;;
   3 ;; JM-man-view.el -- format mail message including roff manual
   4 ;;
   5 ;; Copyright (C) 1999-2001 Akihiro MOTOKI <motoki@dd.iij4u.or.jp>
   6 ;; Time-Stamp: <2001-02-07 13:05:28 motoki>
   7
   8 ;; Required:
   9 ;;  - woman.el (http://centaur.maths.qmw.ac.uk/Emacs/)
  10
  11 ;; Preparation:
  12 ;; (1) Put this file (JM-man-view.el) and woman.el to load-path directory.
  13 ;; (2) Put this in your .emacs:
  14 ;;   ;; woman
  15 ;;   (autoload 'woman "woman"
  16 ;;     "Decode and browse a UN*X man page." t)
  17 ;;   (autoload 'woman-find-file "woman"
  18 ;;     "Find, decode and browse a specific UN*X man-page file." t)
  19 ;;   ;; JM-man-view
  20 ;;   (autoload 'JM-man-view "JM-man-view" nil t)
  21 ;;   (autoload 'JM-man-mail-view "JM-man-view" nil t)
  22
  23 ;; Usage:
  24 ;; (2) Go to the message buffer.
  25 ;; (3) M-x JM-man-view
  26 ;;
  27 ;; For users of Wanderlust or Mew
  28 ;;  In summary mode,
  29 ;;  M-x JM-man-mail-view
  30 ;;          formats manpages included in the message buffer.
  31
  32 ;; This program is free software; you can redistribute it and/or modify
  33 ;; it under the terms of the GNU General Public License as published by
  34 ;; the Free Software Foundation; either version 2, or (at your option)
  35 ;; any later version.
  36 ;;
  37 ;; This program is distributed in the hope that it will be useful,
  38 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  39 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  40 ;; GNU General Public License for more details.
  41 ;;
  42 ;; You should have received a copy of the GNU General Public License
  43 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  44 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  45 ;; Boston, MA 02111-1307, USA.
  46
  47 (require 'woman)
  48
  49 (defvar JM-tempfile-prefix "/tmp/jm"
  50   "Prefix for a temporary filename which JM-man-view.")
  51
  52 (defvar JM-tempfile-list nil
  53   "A List of temporary files which are used by JM-man-view")
  54
  55 (defvar JM-man-view-init nil)
  56 (defvar JM-man-view-version "1.01")
  57
  58 (defvar JM-mew-disp-keybind ?.)
  59
  60 (defun JM-man-view-init ()
  61   (if (null JM-man-view-init)
  62       (progn
  63         (if (not (featurep 'woman))
  64             (error "No woman package!!"))
  65         (add-hook 'kill-emacs-hook 'JM-tempfile-delete)
  66         (setq JM-man-view-init t)
  67         )))
  68
  69 (defun JM-tempfile-make ()
  70   (format "%s%d-%d"
  71           JM-tempfile-prefix
  72           (emacs-pid)
  73           (nth 1 (current-time))))
  74
  75 (defun JM-man-mail-view ()
  76   (interactive)
  77   (JM-man-view-init)
  78   (cond ((string= major-mode "wl-summary-mode")
  79          (wl-summary-jump-to-current-message)
  80          (JM-man-view))
  81         ((string= major-mode "mew-summary-mode")
  82          ;;(mew-summary-display-command)
  83          (funcall (cdr (assoc JM-mew-disp-keybind mew-summary-mode-map)))
  84          (select-window (get-buffer-window
  85                             (get-buffer (mew-buffer-message))))
  86          (JM-man-view))
  87         (t
  88          (message "Please try 'JM-man-view' in message buffer."))))
  89
  90 (defun JM-man-view ()
  91   (interactive)
  92   (JM-man-view-init)
  93   (let ((tempfile (JM-tempfile-make)))
  94     (save-excursion
  95       (beginning-of-buffer)
  96       ;; search beginning of manual message.
  97       (if (re-search-forward "^\.\\\\\"" nil t)
  98           (progn
  99             (beginning-of-line)
 100             (write-region (point) (point-max) tempfile)
 101             (woman-find-file tempfile)
 102             (setq JM-tempfile-list (cons tempfile JM-tempfile-list)))
 103         (message "No manual found.")
 104         ))))
 105
 106 (defun JM-tempfile-delete ()
 107   (interactive)
 108   (let (failed-list)
 109     (mapcar
 110      (lambda (file)
 111        (if (and (file-exists-p file) (file-writable-p file))
 112            (delete-file file)
 113          (setq failed-list (cons file failed-list))))
 114      JM-tempfile-list)
 115     (setq JM-tempfile-list failed-list)))
 116
 117 (provide 'JM-man-view)