File: w3mnav.el

package info (click to toggle)
quack-el 0.27-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 240 kB
  • ctags: 303
  • sloc: lisp: 2,661; sh: 77; makefile: 45
file content (144 lines) | stat: -rw-r--r-- 5,656 bytes parent folder | download
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
134
135
136
137
138
139
140
141
142
143
144
;;; w3m-nav.el --- add additional Info-like navigation to w3m

;; Copyright (C) 2002-3 Neil W. Van Dyke

;; Author:   Neil W. Van Dyke <neil@neilvandyke.org>
;; Version:  0.5
;; X-URL:    http://www.neilvandyke.org/w3mnav/
;; X-CVS:    $Id: w3mnav.el,v 1.14 2003/07/05 23:24:40 neil Exp $ GMT

;; This 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
;; 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
;; GNU Emacs; see the file `COPYING'.  If not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.

;;; Commentary:

;; `w3mnav' kludges some Info-like navigation keys into the `emacs-w3m' Web
;; browser (`http://emacs-w3m.namazu.org/').  This functionality was originally
;; part of Scheme support package Quack (`http://www.neilvandyke.org/quack/'),
;; and was intended to work with the numerous Scheme books that were converted
;; to HTML from LaTeX format.  It also works with some other HTML pages that
;; have book-like "next page" and "previous page" links.
;;
;; To install, put file `w3mnav.el' into one of your Emacs Lisp directories,
;; optionally byte-compile the file, and add a line like the following to your
;; `~/.emacs' file:
;;
;;     (require 'w3mnav)

;;; Change Log:

;; Version 0.5 (05-Jul-2003)  w3mnav's functionality might be incorporated into
;;     the official w3m, but for now w3mnav.el can be used separately.  This
;;     version has a few changes suggested by Katsumi Yamaoka.  Renamed
;;     functions to begin with `w3m-nav' instead of `w3mnav'.  Added `custom'
;;     settings, under the `w3m' group.  `w3mnav-different-browser' removed,
;;     since it appears redundant with the standard
;;     `w3m-view-url-with-external-browser'.
;;
;; Version 0.4 (07-Jan-2003) Removed accidental Quack dependency.
;; Version 0.3 (06-Jan-2002) Comment fixes.
;; Version 0.2 (04-Jan-2003) Fixes.
;; Version 0.1 (03-Jan-2003) Initial release, separated from Quack.

;;; Code:

(eval-and-compile (require 'w3m))

(defcustom w3m-nav-go-next-strings
  '("next" "next page" ">>" "next page >>>")
  "*List of strings for links that `w3m-nav-go-next' can follow."
  :type  '(repeat string)
  :group 'w3m)
  
(defcustom w3m-nav-go-prev-strings
  '("previous" "prev" "previous page" "<<" "<<< previous page")
  "*List of strings for links that `w3m-nav-go-prev' can follow."
  :type  '(repeat string)
  :group 'w3m)
  
(defcustom w3m-nav-go-top-strings
  '("contents" "first" "first page" "up" "up page" "home")
  "*List of strings for links that `w3m-nav-go-top' can follow."
  :type  '(repeat string)
  :group 'w3m)
  
(setq w3m-mode-map w3m-info-like-map)

(define-key w3m-mode-map "t" 'w3m-nav-go-top)
(define-key w3m-mode-map "[" 'w3m-nav-go-prev)
(define-key w3m-mode-map "]" 'w3m-nav-go-next)

(defun w3m-nav-without-side-whitespace (str)
  (save-match-data
    (if (string-match "^[ \t\n\r]+" str)
        (setq str (substring str (match-end 0))))
    (if (string-match "[ \t\n\r]+$" str)
        (setq str (substring str 0 (match-beginning 0))))
    str))

(defun w3m-nav-nav-links ()
  (let* ((result '())
         (search
          (function
           (lambda (start end)
             (let ((last nil))
               (goto-char start)
               (while (and (< (point) end)
                           (w3m-goto-next-anchor)
                           (or (not last)
                               (> (point) last)))
                 (setq last (point))
                 (let ((name-end (next-single-property-change
                                  (point)
                                  'w3m-anchor-sequence))
                       (url      (eval '(w3m-anchor))))
                   (when (and name-end url)
                     (let ((name (downcase (w3m-nav-without-side-whitespace
                                            (buffer-substring-no-properties
                                             (point)
                                             name-end)))))
                       (setq result (cons (cons name url) result)))))))))))
    (save-excursion
      (let* ((top-end (min (+ (point-min) 1000) (point-max))))
        (funcall search (point-min) top-end)
        (when (< top-end (point-max))
          (funcall search (max (- (point-min) 1000) top-end) (point-max)))))
    (reverse result)))

(defun w3m-nav-go (names page-kind)
  (let ((links (w3m-nav-nav-links))
        (url   nil))
    (when links
      (while (and names (not url))
        (setq url (cdr (assoc (car names) links)))
        (setq names (cdr names))))
    (if url
        (w3m-goto-url url)
      (error "Sorry, no %s page link could be found." page-kind))))

(defun w3m-nav-go-next ()
  (interactive)
  (w3m-nav-go w3m-nav-go-next-strings "next"))

(defun w3m-nav-go-prev ()
  (interactive)
  (w3m-nav-go w3m-nav-go-prev-strings "previous"))

(defun w3m-nav-go-top ()
  ;; TODO: We should make separate `t' and `u' commands now.  The `u' command
  ;;       should fallback to `w3m-view-parent-page', which is the normal
  ;;       binding for `u'.  Or perhaps `u' should fallback to "top" and then
  ;;       to the normal binding.
  (interactive)
  (w3m-nav-go w3m-nav-go-top-strings "top"))

(provide 'w3mnav)

;; w3mnav.el ends here