Simplified somewhat -- adjusted to new Perl interface.
[sepia.git] / sepia-w3m.el
blobf94817802c404556dd681f9442e8729a30ddaa83
1 ;;; sepia-w3m.el --- The add-on program to view Perl documents.
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.
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)
15 ;; any later version.
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.
28 ;;; Commentary:
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/
35 ;;; Code:
36 (require 'sepia)
37 (require 'w3m-perldoc)
39 ;;;###autoload
40 (defun w3m-about-buffer-perldoc (url &optional no-decode no-cache &rest args)
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")))))
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)))))
75 ;;;###autoload
76 (defun sepia-w3m-perldoc-this (obj &optional mod type)
77 "View perldoc for module at point."
78 (interactive (multiple-value-list (sepia-ident-at-point)))
79 (let ((mod (if (eq type 'module)
80 mod
81 (or mod (fourth (car
82 (if (eq type 'variable)
83 (xref-var-defs obj)
84 (xref-defs obj mod))))))))
85 (when mod
86 (w3m-perldoc mod)
87 (when (and obj (not (eq type 'module))
88 (re-search-forward
89 (concat "^\\Sw*\\<" obj "\\>") nil t))
90 (beginning-of-line)
91 (recenter)))))
93 (defun sepia-module-list ()
94 (interactive)
95 (let ((file "/tmp/modlist.html"))
96 (unless (file-exists-p file)
97 (with-temp-buffer
98 (insert "use ExtUtils::Installed;
100 print \"<html><body><ul>\";
101 for (sort ExtUtils::Installed->new->modules) {
102 print qq{<li><a href=\"about://perldoc/$_\">$_</a>};
104 print \"</ul></body></html>\n\";
106 (shell-command-on-region (point-min) (point-max)
107 (concat "perl > " file))))
108 (w3m-find-file file)))
110 (provide 'sepia-w3m)
112 ;;; sepia-w3m.el ends here.