File: sepia-w3m.el

package info (click to toggle)
sepia 0.992-7
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 648 kB
  • sloc: perl: 2,811; lisp: 2,655; sh: 46; makefile: 14
file content (133 lines) | stat: -rw-r--r-- 4,972 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
;;; sepia-w3m.el --- The add-on program to view Perl documents.

;; Copyright (C) 2001 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
;; Modified 2004-2008 by Sean O'Rourke to work with Sepia and operate
;; on buffer.

;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
;; Keywords: w3m, perldoc

;; This file is a part of emacs-w3m.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.


;;; Commentary:

;; w3m-perldoc.el is the add-on program of emacs-w3m to view Perl
;; documents.  For more detail about emacs-w3m, see:
;;
;;    http://emacs-w3m.namazu.org/

;;; Code:
(eval-when-compile
  (require 'w3m-perldoc))

;;;###autoload
(defun w3m-about-perldoc-buffer (url &optional no-decode no-cache &rest args)
  "Handle about://perldoc-buffer/ links."
  (when (string-match "\\`about://perldoc-buffer/" url)
    (let ((buf (get-buffer (w3m-url-decode-string
			    (substring url (match-end 0)))))
	  (default-directory w3m-profile-directory)
	  (process-environment (copy-sequence process-environment)))
      ;; To specify the place in which pod2html generates its cache files.
      (setenv "HOME" (expand-file-name w3m-profile-directory))
      (insert-buffer-substring buf)
      (if (zerop (apply #'call-process-region
                        (point-min) (point-max)
                        w3m-perldoc-pod2html-command
                        t '(t nil) nil
                        (append w3m-perldoc-pod2html-arguments
                                '("--index" "--htmlroot=about://perldoc-buffer"))))
          (let ((case-fold-search t))
            (goto-char (point-min))
            (while (re-search-forward
                    "<a href=\"about://perldoc\\(-buffer\\)?/\\([^\"]*\\)\\(\\.html\\)\">" nil t)
              (delete-region (match-beginning 3) (match-end 3))
              (save-restriction
                (narrow-to-region (match-beginning 2) (match-end 2))
                (while (search-backward "/" nil t)
                  (delete-char 1)
                  (insert "::"))
                (goto-char (point-max))))
            "text/html")
        ;; something went wrong
        (message "POD errors in %s" buf)
        (display-buffer (current-buffer))))))

;;;###autoload
(defun sepia-w3m-view-pod (&optional buffer)
  (require 'w3m)
  (w3m-goto-url (concat "about://perldoc-buffer/"
			(w3m-url-encode-string (buffer-name buffer)))))

;;;###autoload
(defun sepia-module-list ()
  "List installed modules with links to their documentation.

This lists not just top-level packages appearing in packlist
files, but all documented modules on the system, organized by
package."
  (interactive)
  (let ((file "/tmp/modlist.html"))
    (unless (file-exists-p file)
      (sepia-eval (format "Sepia::html_module_list(\"%s\")" file)))
    (w3m-find-file file)))

;;;###autoload
(defun sepia-package-list ()
  "List installed packages with links to their documentation.

This lists only top-level packages appearing in packlist files.
For modules within packages, see `sepia-module-list'."
  (interactive)
  (let ((file "/tmp/packlist.html"))
    (unless (file-exists-p file)
      (sepia-eval (format "Sepia::html_package_list(\"%s\")" file)))
    (w3m-find-file file)))

(defun sepia-w3m-create-imenu ()
  "Create imenu index from pod2html output."
  (save-excursion
    (goto-char (point-min))
    (when (looking-at "Location: \\(about://perldoc/[^#]+\\)")
      (let ((base (match-string 1))
            beg end
            list)
        (w3m-view-source)
        (search-forward "<!-- INDEX BEGIN -->")
        (setq beg (point))
        (search-forward "<!-- INDEX END -->")
        (setq end (point))
        (goto-char beg)
        (while (re-search-forward "<a href=\"\\(#[^\"]+\\)\">\\([^<]+\\)" end t)
          (push (cons (match-string 2) (match-string 1)) list))
        (w3m-view-source)
        (nreverse list)))))

(defun sepia-w3m-goto-function (name anchor)
  (if (string-match "^about://perldoc/" w3m-current-url)
      (w3m-goto-url (concat w3m-current-url anchor))
    (imenu-default-goto-function name anchor)))

(defun sepia-w3m-install-imenu ()
  (setq imenu-create-index-function 'sepia-w3m-create-imenu
        imenu-default-goto-function 'sepia-w3m-goto-function))

(provide 'sepia-w3m)

;;; sepia-w3m.el ends here.