comparison lisp/packages/webjump.el @ 155:43dd3413c7c7 r20-3b4

Import from CVS: tag r20-3b4
author cvs
date Mon, 13 Aug 2007 09:39:39 +0200
parents 0d2f883870bc
children
comparison
equal deleted inserted replaced
154:94141801dd7e 155:43dd3413c7c7
1 ;;; webjump.el --- programmable Web hotlist 1 ;;; webjump.el --- programmable Web hotlist
2 2
3 ;; Copyright (C) 1996 Free Software Foundation 3 ;; Copyright (C) 1996-1997 Free Software Foundation
4 4
5 ;; Author: Neil W. Van Dyke <nwv@acm.org> 5 ;; Author: Neil W. Van Dyke <nwv@acm.org>
6 ;; Created: Fri 09 Aug 1996 6 ;; Created: 09-Aug-1996
7 ;; Version: 1.4 7 ;; Keywords: comm www
8 ;; Keywords: webjump web www browse-url
9 ;; X-URL: http://www.cs.brown.edu/people/nwv/ 8 ;; X-URL: http://www.cs.brown.edu/people/nwv/
10 9
11 ;; This file is not yet part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
12 11
13 ;; This is free software; you can redistribute it and/or modify it under the 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; terms of the GNU General Public License as published by the Free Software 13 ;; it under the terms of the GNU General Public License as published by
15 ;; Foundation; either version 2, or (at your option) any later version. 14 ;; the Free Software Foundation; either version 2, or (at your option)
16 15 ;; any later version.
17 ;; This is distributed in the hope that it will be useful, but WITHOUT ANY 16
18 ;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 17 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; details. 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License along with 21
23 ;; GNU Emacs; see the file COPYING. If not, write to the Free Software 22 ;; You should have received a copy of the GNU General Public License
24 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
25 26
26 ;;; Change Log: 27 ;;; Change Log:
27 28
28 ;; [Version 1.4, Tue 17 Sep 1995, nwv] Removed the evil "defconst-TEST" that 29 ;; [Version 1.5, 02-Jun-1997, nwv@acm.org] Prepared for first inclusion in GNU
29 ;; slipped into 1.3. Organized webjump-sample-sites and modified the content a 30 ;; Emacs distribution by merging in RMS' minor changes and moving some sample
30 ;; bit. 31 ;; Web site entries out. Also updated Lycos and Yahoo sample entries.
31 32
32 ;; [Version 1.3, Fri 30 Aug 1996, nwv] Fixed broken `if' function in 33 ;; [Version 1.4, 17-Sep-1996, nwv@acm.org] Removed the evil "defconst-TEST"
34 ;; that slipped into 1.3. Organized webjump-sample-sites and modified the
35 ;; content a bit.
36
37 ;; [Version 1.3, 30-Aug-1996, nwv@acm.org] Fixed broken `if' function in
33 ;; `webjump-to-javaapi' (bugfix already posted). Added `webjump-to-iwin'. 38 ;; `webjump-to-javaapi' (bugfix already posted). Added `webjump-to-iwin'.
34 ;; Added comment on purpose of `webjump-sample-sites'. Added 39 ;; Added comment on purpose of `webjump-sample-sites'. Added
35 ;; `webjump-read-choice'. 40 ;; `webjump-read-choice'.
36 41
37 ;; [Version 1.2, Fri 16 Aug 1996, nwv] Oops, got Gamelan mixed up with Digital 42 ;; [Version 1.2, 16-Aug-1996, nwv@acm.org] Oops, got Gamelan mixed up with
38 ;; Espresso somehow. Added `mirrors' builtin and used it for the sample GNU 43 ;; Digital Espresso somehow. Added `mirrors' builtin and used it for the
39 ;; Archive site. Added some other sample sites. Split sample sites out into 44 ;; sample GNU Archive site. Added some other sample sites. Split sample sites
40 ;; separate constant. Misc. small changes. Copyright has been transferred to 45 ;; out into separate constant. Misc. small changes. Copyright has been
41 ;; the FSF. 46 ;; transferred to the FSF.
42 47
43 ;; [Version 1.1, Sat 10 Aug 1996, nwv] Added missing call to `webjump-url-fix' 48 ;; [Version 1.1, 10-Aug-1996, nwv@acm.org] Added missing call to
44 ;; (thanks to Istvan Marko <mi@bgytf.hu> for pointing this out). Added 49 ;; `webjump-url-fix' (thanks to Istvan Marko <mi@bgytf.hu> for pointing this
45 ;; ``builtins'' concept in order to support `simple-query' builtin for covering 50 ;; out). Added ``builtins'' concept in order to support `simple-query' builtin
46 ;; the majority of cases. Added a couple more sample sites. 51 ;; for covering the majority of cases. Added a couple more sample sites.
47 52
48 ;; [Version 1.0, Fri 09 Aug 1996, nwv] Wrote initial version and posted to 53 ;; [Version 1.0, 09-Aug-1996, nwv@acm.org] Wrote initial version and posted to
49 ;; gnu.emacs.sources. 54 ;; gnu.emacs.sources.
50 55
51 ;;; Commentary: 56 ;;; Commentary:
52 57
53 ;; WebJump provides a sort of ``programmable hotlist'' of Web sites that can 58 ;; WebJump provides a sort of ``programmable hotlist'' of Web sites that can
65 ;; example sites. You'll probably want to override it with your own favorite 70 ;; example sites. You'll probably want to override it with your own favorite
66 ;; sites. The documentation for the variable describes the syntax. 71 ;; sites. The documentation for the variable describes the syntax.
67 72
68 ;; You may wish to add something like the following to your `.emacs' file: 73 ;; You may wish to add something like the following to your `.emacs' file:
69 ;; 74 ;;
70 ;; (load "webjump") 75 ;; (require 'webjump)
71 ;; (global-set-key "\C-c\C-j" 'webjump) 76 ;; (global-set-key "\C-cj" 'webjump)
72 ;; (setq webjump-sites 77 ;; (setq webjump-sites
73 ;; (append '( 78 ;; (append '(
74 ;; ("My Home Page" . "www.someisp.net/users/joebobjr/") 79 ;; ("My Home Page" . "www.someisp.net/users/joebobjr/")
75 ;; ("Pop's Site" . "www.joebob-and-son.com/") 80 ;; ("Pop's Site" . "www.joebob-and-son.com/")
76 ;; ) 81 ;; )
77 ;; webjump-sample-sites)) 82 ;; webjump-sample-sites))
78 ;; 83 ;;
79 ;; The above loads this package, binds `C-c C-j' to invoke WebJump, and adds 84 ;; The above loads this package, binds `C-c j' to invoke WebJump, and adds your
80 ;; your personal favorite sites to the hotlist. 85 ;; personal favorite sites to the hotlist.
81 86
82 ;; The `webjump-sample-sites' constant mostly contains sites that are expected 87 ;; The `webjump-sample-sites' variable mostly contains some site entries that
83 ;; to be generally useful to Emacs users or that have some sort of query which 88 ;; are expected to be generally relevant to most Emacs users. Some additional
84 ;; can be coded in WebJump. There are two main goals of this sample site list: 89 ;; site entries are defined in the separate and more frequently updated
85 ;; (1) demonstrate WebJump capabilities and usage; (2) provide definitions for 90 ;; `webjump-plus' package, which is available from the author's Web site.
86 ;; many popular sites so that people don't have to reinvent the wheel. A few
87 ;; assorted other sites have been thrown in on a whim. No commercial sites are
88 ;; included unless they provide a free, generally-useful service. Inclusion of
89 ;; a site does not represent an endorsement. Please contact the maintainer
90 ;; with change requests.
91 91
92 ;; The `browse-url' package is used to submit URLs to the browser, so any 92 ;; The `browse-url' package is used to submit URLs to the browser, so any
93 ;; browser-specific configuration should be done there. 93 ;; browser-specific configuration should be done there.
94 94
95 ;; WebJump inherits a small amount code from my `altavista.el' package, and is 95 ;; WebJump inherits a small amount code from my `altavista.el' package, and is
99 99
100 ;;-------------------------------------------------------- Package Dependencies 100 ;;-------------------------------------------------------- Package Dependencies
101 101
102 (require 'browse-url) 102 (require 'browse-url)
103 103
104 ;;------------------------------------------------------ Package Identification
105
106 (defconst webjump-version "1.4")
107 (defconst webjump-author "Neil W. Van Dyke <nwv@acm.org>")
108 (defconst webjump-maintainer-address "nwv@acm.org")
109 (defconst webjump-vc-id
110 "$Id: webjump.el,v 1.1 1997/02/14 19:21:27 steve Exp $")
111
112 ;;------------------------------------------------------------------- Constants 104 ;;------------------------------------------------------------------- Constants
113 105
114 (defconst webjump-sample-sites 106 (defvar webjump-version "1.5")
107
108 (defvar webjump-sample-sites
115 '( 109 '(
116 110
117 ;; FSF, not including Emacs-specific. 111 ;; FSF, not including Emacs-specific.
118 ("GNU Project FTP Archive". 112 ("GNU Project FTP Archive" .
119 [mirrors "ftp://prep.ai.mit.edu/pub/gnu/" 113 [mirrors "ftp://prep.ai.mit.edu/pub/gnu/"
120 ;; ASIA: 114 ;; ASIA:
121 "ftp://ftp.cs.titech.ac.jp" 115 "ftp://ftp.cs.titech.ac.jp"
122 "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/prep" 116 "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/prep"
123 "ftp://cair-archive.kaist.ac.kr/pub/gnu" 117 "ftp://cair-archive.kaist.ac.kr/pub/gnu"
167 "ftp://uiarchive.cso.uiuc.edu/pub/gnu" 161 "ftp://uiarchive.cso.uiuc.edu/pub/gnu"
168 "ftp://ftp.cs.columbia.edu/archives/gnu/prep" 162 "ftp://ftp.cs.columbia.edu/archives/gnu/prep"
169 "ftp://gatekeeper.dec.com/pub/GNU" 163 "ftp://gatekeeper.dec.com/pub/GNU"
170 "ftp://ftp.uu.net/systems/gnu"]) 164 "ftp://ftp.uu.net/systems/gnu"])
171 ("GNU Project Home Page" . "www.fsf.org") 165 ("GNU Project Home Page" . "www.fsf.org")
172 ;"www.gnu.ai.mit.edu"
173 ;"agnes.dida.physik.uni-essen.de/~gnu"
174 166
175 ;; Emacs. 167 ;; Emacs.
176 ("Eieio" . "ftp.ultranet.com/pub/zappo/") 168 ("Eieio" . "ftp.ultranet.com/pub/zappo/")
177 ("Emacs Lisp Archive" . 169 ("Emacs Lisp Archive" .
178 "ftp://archive.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive/") 170 "ftp://archive.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive/")
179 ("Insidious Big Brother Database" . "home.netscape.com/people/jwz/bbdb/") 171 ("Insidious Big Brother Database" . "home.netscape.com/people/jwz/bbdb/")
180 ;"ftp.xemacs.org/pub/bbdb/"
181 ("Mailcrypt" . "cag-www.lcs.mit.edu/mailcrypt/") 172 ("Mailcrypt" . "cag-www.lcs.mit.edu/mailcrypt/")
182 ("XEmacs Home" . "www.xemacs.org") ; Doesn't hurt to have this here. :) 173 ("WebJump" . "http://www.cs.brown.edu/people/nwv/projects/webjump/")
174 ("XEmacs Home" . "www.xemacs.org")
183 ("Yahoo: Emacs" . 175 ("Yahoo: Emacs" .
184 "www.yahoo.com/Computers_and_Internet/Software/Editors/Emacs/") 176 "www.yahoo.com/Computers_and_Internet/Software/Text_Editors/Emacs/")
185 177
186 ;; General interest. 178 ;; Internet search engines.
187 ("AltaVista" . 179 ("AltaVista" .
188 [simple-query 180 [simple-query
189 "www.altavista.digital.com" 181 "www.altavista.digital.com"
190 "www.altavista.digital.com/cgi-bin/query?pg=aq&what=web&fmt=.&q=" 182 "www.altavista.digital.com/cgi-bin/query?pg=aq&what=web&fmt=.&q="
191 "&r=&d0=&d1="]) 183 "&r=&d0=&d1="])
192 ("Archie" . 184 ("Archie" .
193 [simple-query "http://hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl" 185 [simple-query "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl"
194 "http://hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl?query=" ""]) 186 "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl?query=" ""])
187 ("Lycos" .
188 [simple-query "www.lycos.com"
189 "www.lycos.com/cgi-bin/pursuit?cat=lycos&query=" ""])
190 ("Yahoo" .
191 [simple-query "www.yahoo.com" "search.yahoo.com/bin/search?p=" ""])
192
193 ;; Misc. general interest.
195 ("Interactive Weather Information Network" . webjump-to-iwin) 194 ("Interactive Weather Information Network" . webjump-to-iwin)
196 ("Lycos" .
197 [simple-query "www.lycos.com" "www.lycos.com/cgi-bin/pursuit?query=" ""])
198 ("Usenet FAQs" . 195 ("Usenet FAQs" .
199 [simple-query "www.cis.ohio-state.edu/hypertext/faq/usenet/FAQ-List.html" 196 [simple-query "www.cis.ohio-state.edu/hypertext/faq/usenet/FAQ-List.html"
200 "www.cis.ohio-state.edu/htbin/search-usenet-faqs/form?find=" 197 "www.cis.ohio-state.edu/htbin/search-usenet-faqs/form?find="
201 ""]) 198 ""])
202 ("RTFM Usenet FAQs by Group" . 199 ("RTFM Usenet FAQs by Group" .
205 "ftp://rtfm.mit.edu/pub/usenet-by-hierarchy/") 202 "ftp://rtfm.mit.edu/pub/usenet-by-hierarchy/")
206 ("Webster" . 203 ("Webster" .
207 [simple-query "c.gp.cs.cmu.edu:5103/prog/webster" 204 [simple-query "c.gp.cs.cmu.edu:5103/prog/webster"
208 "gs213.sp.cs.cmu.edu/prog/webster?" ""]) 205 "gs213.sp.cs.cmu.edu/prog/webster?" ""])
209 ("X Consortium Archive". "ftp.x.org") 206 ("X Consortium Archive". "ftp.x.org")
210 ("Yahoo" . 207 ("Yahoo: Reference" . "www.yahoo.com/Reference/")
211 [simple-query "www.yahoo.com" "search.yahoo.com/bin/search?p=" ""]) 208
212 ("Yahoo: Reference" "www.yahoo.com/Reference/") 209 ;; Computer social issues, privacy, professionalism.
213 210 ("Association for Computing Machinery" . "www.acm.org")
214 ;; Computer privacy and social issues.
215 ("Computer Professionals for Social Responsibility" . "www.cpsr.org/dox/") 211 ("Computer Professionals for Social Responsibility" . "www.cpsr.org/dox/")
216 ("Electronic Frontier Foundation" . "www.eff.org") 212 ("Electronic Frontier Foundation" . "www.eff.org")
213 ("IEEE Computer Society" . "www.computer.org")
217 ("Pretty Good Privacy" . "web.mit.edu/network/pgp.html") 214 ("Pretty Good Privacy" . "web.mit.edu/network/pgp.html")
218 ("Risks Digest" . webjump-to-risks) 215 ("Risks Digest" . webjump-to-risks)
219 216
220 ;; Java.
221 ("Digital Espresso" .
222 [simple-query "www.io.org/~mentor/DigitalEspresso.html"
223 "www.jars.com/cgi-bin/aglimpse/01?query="
224 "&case=on&whole=on&errors=0&maxfiles=100&maxlines=30"])
225 ("Java API" . webjump-to-javaapi)
226
227 ;; Fun. 217 ;; Fun.
228 ("Bastard Operator from Hell" . "www.replay.com/bofh/") 218 ("Bastard Operator from Hell" . "www.replay.com/bofh/")
229 ("Dilbert" . "www.unitedmedia.com/comics/dilbert/")
230 ("Playboy" . (if (webjump-adult-p) "www.playboy.com" "www.whitehouse.gov"))
231
232 ;; Author's indulgence.
233 ("Brown University" .
234 [simple-query "www.brown.edu" "www.brown.edu/cgi-local/bsearch?" ""])
235 219
236 ) 220 )
237 "Sample hotlist for WebJump.") 221 "Sample hotlist for WebJump. See the documentation for the `webjump'
238 222 function and the `webjump-sites' variable.")
239 (defconst webjump-state-to-postal-alist 223
224 (defvar webjump-state-to-postal-alist
240 '(("Alabama" . "al") ("Alaska" . "ak") ("Arizona" . "az") ("Arkansas" . "ar") 225 '(("Alabama" . "al") ("Alaska" . "ak") ("Arizona" . "az") ("Arkansas" . "ar")
241 ("California" . "ca") ("Colorado" . "co") ("Connecticut" . "ct") 226 ("California" . "ca") ("Colorado" . "co") ("Connecticut" . "ct")
242 ("Delaware" . "de") ("Florida" . "fl") ("Georgia" . "ga") ("Hawaii" . "hi") 227 ("Delaware" . "de") ("Florida" . "fl") ("Georgia" . "ga") ("Hawaii" . "hi")
243 ("Idaho" . "id") ("Illinois" . "il") ("Indiana" . "in") ("Iowa" . "ia") 228 ("Idaho" . "id") ("Illinois" . "il") ("Indiana" . "in") ("Iowa" . "ia")
244 ("Kansas" . "ks") ("Kentucky" . "ky") ("Louisiana" . "la") ("Maine" . "me") 229 ("Kansas" . "ks") ("Kentucky" . "ky") ("Louisiana" . "la") ("Maine" . "me")
314 ("Watches and Warnings" . "warnings")) 299 ("Watches and Warnings" . "warnings"))
315 "zone") 300 "zone")
316 ".html") 301 ".html")
317 prefix))) 302 prefix)))
318 303
319 (defun webjump-to-javaapi (name)
320 (let* ((prefix "http://www.javasoft.com/products/JDK/CurrentRelease/api/")
321 (packages '(("java.applet") ("java.awt") ("java.awt.image")
322 ("java.awt.peer") ("java.io") ("java.lang") ("java.net")
323 ("java.util") ("sun.tools.debug")))
324 (completion-ignore-case t)
325 (package (completing-read (concat name " package: ") packages nil t)))
326 (if (webjump-null-or-blank-string-p package)
327 (concat prefix "packages.html")
328 (concat prefix "Package-" package ".html"))))
329
330 (defun webjump-to-risks (name) 304 (defun webjump-to-risks (name)
331 (let (issue volume) 305 (let (issue volume)
332 (if (and (setq volume (webjump-read-number (concat name " volume"))) 306 (if (and (setq volume (webjump-read-number (concat name " volume")))
333 (setq issue (webjump-read-number (concat name " issue")))) 307 (setq issue (webjump-read-number (concat name " issue"))))
334 (format "catless.ncl.ac.uk/Risks/%d.%02d.html" volume issue) 308 (format "catless.ncl.ac.uk/Risks/%d.%02d.html" volume issue)
341 "Jumps to a Web site from a programmable hotlist. 315 "Jumps to a Web site from a programmable hotlist.
342 316
343 See the documentation for the `webjump-sites' variable for how to customize the 317 See the documentation for the `webjump-sites' variable for how to customize the
344 hotlist. 318 hotlist.
345 319
346 Feedback on WebJump can be sent to the author, Neil W. Van Dyke <nwv@acm.org>, 320 Please submit bug reports and other feedback to the author, Neil W. Van Dyke
347 or submitted via `\\[webjump-submit-bug-report]'. The latest version can be 321 <nwv@acm.org>.
348 gotten from `http://www.cs.brown.edu/people/nwv/'." 322
323 The latest version can be gotten from `http://www.cs.brown.edu/people/nwv/'.
324 That Web site also contains `webjump-plus.el', a larger and more frequently
325 updated sample WebJump hotlist."
349 (interactive) 326 (interactive)
350 (let* ((completion-ignore-case t) 327 (let* ((completion-ignore-case t)
351 (item (assoc (completing-read "WebJump to site: " webjump-sites nil t) 328 (item (assoc (completing-read "WebJump to site: " webjump-sites nil t)
352 webjump-sites)) 329 webjump-sites))
353 (name (car item)) 330 (name (car item))
363 (funcall expr name) 340 (funcall expr name)
364 (error "WebJump URL function \"%s\" undefined." expr))) 341 (error "WebJump URL function \"%s\" undefined." expr)))
365 (t (error "WebJump URL expression for \"%s\" invalid." 342 (t (error "WebJump URL expression for \"%s\" invalid."
366 name))))))) 343 name)))))))
367 344
368 (defun webjump-adult-p ()
369 (and (boundp 'age) (integerp age) (>= age 21)))
370
371 (defun webjump-builtin (expr name) 345 (defun webjump-builtin (expr name)
372 (if (< (length expr) 1) 346 (if (< (length expr) 1)
373 (error "WebJump URL builtin for \"%s\" empty." name)) 347 (error "WebJump URL builtin for \"%s\" empty." name))
374 (let ((builtin (aref expr 0))) 348 (let ((builtin (aref expr 0)))
375 (cond 349 (cond
403 noquery-url))) 377 noquery-url)))
404 378
405 (defun webjump-mirror-default (urls) 379 (defun webjump-mirror-default (urls)
406 ;; Note: This should be modified to apply some simple kludges/heuristics to 380 ;; Note: This should be modified to apply some simple kludges/heuristics to
407 ;; pick a site which is likely "close". As a tie-breaker among candidates 381 ;; pick a site which is likely "close". As a tie-breaker among candidates
408 ;; judged equally desirable, randomness should be used. 382 ;; judged equally desirable, randomness might be used.
409 (car urls)) 383 (car urls))
410 384
411 (defun webjump-read-choice (name what choices &optional default) 385 (defun webjump-read-choice (name what choices &optional default)
412 (let* ((completion-ignore-case t) 386 (let* ((completion-ignore-case t)
413 (choice (completing-read (concat name " " what ": ") choices nil t))) 387 (choice (completing-read (concat name " " what ": ") choices nil t)))
439 (car (assoc input completions))))) 413 (car (assoc input completions)))))
440 414
441 (defun webjump-null-or-blank-string-p (str) 415 (defun webjump-null-or-blank-string-p (str)
442 (or (null str) (string-match "^[ \t]*$" str))) 416 (or (null str) (string-match "^[ \t]*$" str)))
443 417
444 (defun webjump-submit-bug-report ()
445 "Submit via mail a bug report on WebJump."
446 (interactive)
447 (require 'reporter)
448 (reporter-submit-bug-report
449 webjump-maintainer-address
450 (concat "webjump.el " webjump-version " " webjump-vc-id)
451 '(webjump-sites)
452 nil
453 nil
454 (concat
455 "[Dear bug report submitter: Please ensure that the variable dumps\n"
456 "below do not contain any information you consider private.]\n")))
457
458 (defun webjump-url-encode (str) 418 (defun webjump-url-encode (str)
459 (mapconcat '(lambda (c) 419 (mapconcat '(lambda (c)
460 (cond ((= c 32) "+") 420 (cond ((= c 32) "+")
461 ((or (and (>= c ?a) (<= c ?z)) 421 ((or (and (>= c ?a) (<= c ?z))
462 (and (>= c ?A) (<= c ?Z)) 422 (and (>= c ?A) (<= c ?Z))