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 by Sean O'Rourke to work with Sepia and operate on
   5 ;; 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 (require 'w3m-perldoc)
  37
  38 ;;;###autoload
  39 (defun w3m-about-perldoc-buffer (url &optional no-decode no-cache &rest args)
  40   "Handle about://perldoc-buffer/ links."
  41   (when (string-match "\\`about://perldoc-buffer/" url)
  42     (let ((buf (get-buffer (w3m-url-decode-string
  43                             (substring url (match-end 0)))))
  44           (default-directory w3m-profile-directory)
  45           (process-environment (copy-sequence process-environment)))
  46       ;; To specify the place in which pod2html generates its cache files.
  47       (setenv "HOME" (expand-file-name w3m-profile-directory))
  48       (insert-buffer buf)
  49       (when (zerop (apply #'call-process-region
  50                           (point-min) (point-max)
  51                           w3m-perldoc-pod2html-command
  52                           t '(t nil) nil
  53                           (append w3m-perldoc-pod2html-arguments
  54                                   '("--htmlroot=about://perldoc-buffer"))))
  55         (let ((case-fold-search t))
  56           (goto-char (point-min))
  57           (while (re-search-forward
  58                   "<a href=\"about://perldoc\\(-buffer\\)?/\\([^\"]*\\)\\(\\.html\\)\">" nil t)
  59             (delete-region (match-beginning 3) (match-end 3))
  60             (save-restriction
  61               (narrow-to-region (match-beginning 2) (match-end 2))
  62               (while (search-backward "/" nil t)
  63                 (delete-char 1)
  64                 (insert "::"))
  65               (goto-char (point-max))))
  66           "text/html")))))
  67
  68 ;;;###autoload
  69 (defun sepia-w3m-view-pod (&optional buffer)
  70   "View POD for the current buffer."
  71   (interactive)
  72   (w3m-goto-url (concat "about://perldoc-buffer/"
  73                         (w3m-url-encode-string (buffer-name buffer)))))
  74
  75 ;;;###autoload
  76 (defun sepia-w3m-perldoc-this (mod)
  77   "View perldoc for module at point."
  78   (interactive (list (sepia-interactive-arg 'module)))
  79   (w3m-perldoc mod))
  80
  81 (defun sepia-module-list ()
  82   "List installed (documented) modules in an HTML page, with
  83 links to their documentation."
  84   (interactive)
  85   (let ((file "/tmp/modlist.html"))
  86     (unless (file-exists-p file)
  87       (with-temp-buffer
  88         (insert "use ExtUtils::Installed;
  89
  90 print \"<html><body><ul>\";
  91 my $inst = new ExtUtils::Installed;
  92 for (sort $inst->modules) {
  93     print qq{<li>$_<ul>};
  94     for (sort $inst->files($_)) {
  95         if (/\\.\\dpm$/) {
  96             s/.*man.\\///; s|/|::|g;s/\..?pm//;
  97             print qq{<li><a href=\"about://perldoc/$_\">$_</a>};
  98         }
  99     }
 100     print '</ul>';
 101 }
 102 print \"</ul></body></html>\n\";
 103 ")
 104         (shell-command-on-region (point-min) (point-max)
 105                                  (concat "perl > " file))))
 106     (w3m-find-file file)))
 107
 108 (defun sepia-package-list ()
 109   "List installed modules in an HTML page, with links to their documentation."
 110   (interactive)
 111   (let ((file "/tmp/packlist.html"))
 112     (unless (file-exists-p file)
 113       (with-temp-buffer
 114         (insert "use ExtUtils::Installed;
 115
 116 print \"<html><body><ul>\";
 117 for (sort ExtUtils::Installed->new->modules) {
 118     print qq{<li><a href=\"about://perldoc/$_\">$_</a>};
 119 }
 120 print \"</ul></body></html>\n\";
 121 ")
 122         (shell-command-on-region (point-min) (point-max)
 123                                  (concat "perl > " file))))
 124     (w3m-find-file file)))
 125
 126 (defun sepia-module-list ()
 127   "List installed modules in an HTML page, with links to their documentation."
 128   (interactive)
 129   (let ((file "/tmp/modlist.html"))
 130     (unless (file-exists-p file)
 131       (with-temp-buffer
 132         (insert "use ExtUtils::Installed;
 133
 134 print \"<html><body><ul>\";
 135 for (sort ExtUtils::Installed->new->modules) {
 136     print qq{<li><a href=\"about://perldoc/$_\">$_</a>};
 137 }
 138 print \"</ul></body></html>\n\";
 139 ")
 140         (shell-command-on-region (point-min) (point-max)
 141                                  (concat "perl > " file))))
 142     (w3m-find-file file)))
 143
 144 (provide 'sepia-w3m)
 145
 146 ;;; sepia-w3m.el ends here.