sepia-w3m.el

   1 ;;; sepia-w3m.el --- The add-on program to view Perl documents.
   2
   3 ;; Copyright (C) 2001 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
   4 ;; Modified 2004-2008 by Sean O'Rourke to work with Sepia and operate
   5 ;; on buffer.
   6
   7 ;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
   8 ;; Keywords: w3m, perldoc
   9
  10 ;; This file is a part of emacs-w3m.
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; if not, you can either send email to this
  24 ;; program's maintainer or write to: The Free Software Foundation,
  25 ;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
  26
  27
  28 ;;; Commentary:
  29
  30 ;; w3m-perldoc.el is the add-on program of emacs-w3m to view Perl
  31 ;; documents.  For more detail about emacs-w3m, see:
  32 ;;
  33 ;;    http://emacs-w3m.namazu.org/
  34
  35 ;;; Code:
  36 (eval-when-compile
  37   (require 'w3m-perldoc))
  38
  39 ;;;###autoload
  40 (defun w3m-about-perldoc-buffer (url &optional no-decode no-cache &rest args)
  41   "Handle about://perldoc-buffer/ links."
  42   (when (string-match "\\`about://perldoc-buffer/" url)
  43     (let ((buf (get-buffer (w3m-url-decode-string
  44                             (substring url (match-end 0)))))
  45           (default-directory w3m-profile-directory)
  46           (process-environment (copy-sequence process-environment)))
  47       ;; To specify the place in which pod2html generates its cache files.
  48       (setenv "HOME" (expand-file-name w3m-profile-directory))
  49       (insert-buffer-substring buf)
  50       (if (zerop (apply #'call-process-region
  51                         (point-min) (point-max)
  52                         w3m-perldoc-pod2html-command
  53                         t '(t nil) nil
  54                         (append w3m-perldoc-pod2html-arguments
  55                                 '("--index" "--htmlroot=about://perldoc-buffer"))))
  56           (let ((case-fold-search t))
  57             (goto-char (point-min))
  58             (while (re-search-forward
  59                     "<a href=\"about://perldoc\\(-buffer\\)?/\\([^\"]*\\)\\(\\.html\\)\">" nil t)
  60               (delete-region (match-beginning 3) (match-end 3))
  61               (save-match-data
  62                 (when (looking-at "the \\(\\S-+\\) manpage")
  63                   (replace-match (match-string 1))))
  64               (save-restriction
  65                 (narrow-to-region (match-beginning 2) (match-end 2))
  66                 (while (search-backward "/" nil t)
  67                   (delete-char 1)
  68                   (insert "::"))
  69                 (goto-char (point-max))))
  70             "text/html")
  71         ;; something went wrong
  72         (message "POD errors in %s" buf)
  73         (display-buffer (current-buffer))))))
  74
  75 (defadvice w3m-about-perldoc (after fix-the-manpage)
  76   "Handle about://perldoc-buffer/ links."
  77   (when (string-match "\\`about://perldoc/" url)
  78     (goto-char (point-min))
  79     (while (re-search-forward
  80             "<a href=\"about://perldoc/\\([^\"]*\\)\\(\\.html\\)\">" nil t)
  81       (save-match-data
  82         (when (looking-at "the \\(\\S-+\\) manpage")
  83           (replace-match (match-string 1)))))
  84     "text/html"))
  85
  86 ;;;###autoload
  87 (defun sepia-w3m-view-pod (&optional buffer)
  88   (require 'w3m)
  89   (w3m-goto-url (concat "about://perldoc-buffer/"
  90                         (w3m-url-encode-string (buffer-name buffer)))))
  91
  92 ;;;###autoload
  93 (defun sepia-module-list ()
  94   "List installed modules with links to their documentation.
  95
  96 This lists not just top-level packages appearing in packlist
  97 files, but all documented modules on the system, organized by
  98 package."
  99   (interactive)
 100   (let ((file "/tmp/modlist.html"))
 101     (unless (file-exists-p file)
 102       (sepia-eval (format "Sepia::html_module_list(\"%s\")" file)))
 103     (w3m-find-file file)))
 104
 105 ;;;###autoload
 106 (defun sepia-package-list ()
 107   "List installed packages with links to their documentation.
 108
 109 This lists only top-level packages appearing in packlist files.
 110 For modules within packages, see `sepia-module-list'."
 111   (interactive)
 112   (let ((file "/tmp/packlist.html"))
 113     (unless (file-exists-p file)
 114       (sepia-eval (format "Sepia::html_package_list(\"%s\")" file)))
 115     (w3m-find-file file)))
 116
 117 (defun sepia-w3m-create-imenu ()
 118   "Create imenu index from pod2html output."
 119   (save-excursion
 120     (goto-char (point-min))
 121     (when (looking-at "Location: \\(about://perldoc/[^#]+\\)")
 122       (let ((base (match-string 1))
 123             beg end
 124             list)
 125         (w3m-view-source)
 126         (search-forward "<!-- INDEX BEGIN -->")
 127         (setq beg (point))
 128         (search-forward "<!-- INDEX END -->")
 129         (setq end (point))
 130         (goto-char beg)
 131         (while (re-search-forward "<a href=\"\\(#[^\"]+\\)\">\\([^<]+\\)" end t)
 132           (push (cons (match-string 2) (match-string 1)) list))
 133         (w3m-view-source)
 134         (nreverse list)))))
 135
 136 (defun sepia-w3m-goto-function (name anchor)
 137   (if (string-match "^about://perldoc/" w3m-current-url)
 138       (w3m-goto-url (concat w3m-current-url anchor))
 139     (imenu-default-goto-function name anchor)))
 140
 141 (defun sepia-w3m-install-imenu ()
 142   (setq imenu-create-index-function 'sepia-w3m-create-imenu
 143         imenu-default-goto-function 'sepia-w3m-goto-function))
 144
 145 (provide 'sepia-w3m)
 146
 147 ;;; sepia-w3m.el ends here.