1 ;;; sepia-w3m.el --- The add-on program to view Perl documents.
3 ;; Copyright (C) 2001 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
4 ;; Modified 2004-2008 by Sean O'Rourke to work with Sepia and operate
7 ;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
8 ;; Keywords: w3m, perldoc
10 ;; This file is a part of emacs-w3m.
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)
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.
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.
30 ;; w3m-perldoc.el is the add-on program of emacs-w3m to view Perl
31 ;; documents. For more detail about emacs-w3m, see:
33 ;; http://emacs-w3m.namazu.org/
37 (require 'w3m-perldoc
))
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
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))
62 (when (looking-at "the \\(\\S-+\\) manpage")
63 (replace-match (match-string 1))))
65 (narrow-to-region (match-beginning 2) (match-end 2))
66 (while (search-backward "/" nil t
)
69 (goto-char (point-max))))
71 ;; something went wrong
72 (message "POD errors in %s" buf
)
73 (display-buffer (current-buffer))))))
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
)
82 (when (looking-at "the \\(\\S-+\\) manpage")
83 (replace-match (match-string 1)))))
87 (defun sepia-w3m-view-pod (&optional buffer
)
89 (w3m-goto-url (concat "about://perldoc-buffer/"
90 (w3m-url-encode-string (buffer-name buffer
)))))
93 (defun sepia-module-list ()
94 "List installed modules with links to their documentation.
96 This lists not just top-level packages appearing in packlist
97 files, but all documented modules on the system, organized by
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
)))
106 (defun sepia-package-list ()
107 "List installed packages with links to their documentation.
109 This lists only top-level packages appearing in packlist files.
110 For modules within packages, see `sepia-module-list'."
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
)))
117 (defun sepia-w3m-create-imenu ()
118 "Create imenu index from pod2html output."
120 (goto-char (point-min))
121 (when (looking-at "Location: \\(about://perldoc/[^#]+\\)")
122 (let ((base (match-string 1))
126 (search-forward "<!-- INDEX BEGIN -->")
128 (search-forward "<!-- INDEX END -->")
131 (while (re-search-forward "<a href=\"\\(#[^\"]+\\)\">\\([^<]+\\)" end t
)
132 (push (cons (match-string 2) (match-string 1)) list
))
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
)))
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
))
147 ;;; sepia-w3m.el ends here.