lisp/net/webjump.el

   1 ;;; webjump.el --- programmable Web hotlist
   2
   3 ;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author:    Neil W. Van Dyke <nwv@acm.org>
   7 ;; Created:   09-Aug-1996
   8 ;; Keywords:  comm www
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs 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 3, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs 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.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; WebJump provides a sort of ``programmable hotlist'' of Web sites that can
  30 ;; quickly be invoked in your Web browser.  Each Web site in the hotlist has a
  31 ;; name, and you select the desired site name via a completing string prompt in
  32 ;; the minibuffer.  The URL for each Web site is defined as a static string or
  33 ;; a built-in or custom function, allowing interactive prompting for
  34 ;; site-specific queries and options.
  35
  36 ;; Note that WebJump was originally intended to complement your conventional
  37 ;; browser-based hotlist, not replace it.  (Though there's no reason you
  38 ;; couldn't use WebJump for your entire hotlist if you were so inclined.)
  39
  40 ;; The `webjump-sites' variable, which defines the hotlist, defaults to some
  41 ;; example sites.  You'll probably want to override it with your own favorite
  42 ;; sites.  The documentation for the variable describes the syntax.
  43
  44 ;; You may wish to add something like the following to your `.emacs' file:
  45 ;;
  46 ;;   (require 'webjump)
  47 ;;   (global-set-key "\C-cj" 'webjump)
  48 ;;   (setq webjump-sites
  49 ;;         (append '(
  50 ;;                   ("My Home Page" . "www.someisp.net/users/joebobjr/")
  51 ;;                   ("Pop's Site"   . "www.joebob-and-son.com/")
  52 ;;                   )
  53 ;;                 webjump-sample-sites))
  54 ;;
  55 ;; The above loads this package, binds `C-c j' to invoke WebJump, and adds your
  56 ;; personal favorite sites to the hotlist.
  57
  58 ;; The `webjump-sample-sites' variable mostly contains some site entries that
  59 ;; are expected to be generally relevant to many users, but excluding
  60 ;; those that the GNU project would not want to recommend.
  61
  62 ;; The `browse-url' package is used to submit URLs to the browser, so any
  63 ;; browser-specific configuration should be done there.
  64
  65 ;;; Code:
  66
  67 ;;-------------------------------------------------------- Package Dependencies
  68
  69 (require 'browse-url)
  70
  71 ;;------------------------------------------------------------------- Constants
  72
  73 (defvar webjump-sample-sites
  74   '(
  75     ;; FSF, not including Emacs-specific.
  76     ("GNU Project FTP Archive" .
  77      ;; GNU FTP Mirror List from http://www.gnu.org/order/ftp.html
  78      [mirrors "ftp://ftp.gnu.org/pub/gnu/"
  79               ;; United States
  80               "ftp://mirrors.kernel.org/gnu"
  81               "ftp://gatekeeper.dec.com/pub/GNU/"
  82               "ftp://ftp.keystealth.org/pub/gnu/"
  83               "ftp://mirrors.usc.edu/pub/gnu/"
  84               "ftp://cudlug.cudenver.edu/pub/mirrors/ftp.gnu.org/"
  85               "ftp://ftp.cise.ufl.edu/pub/mirrors/GNU/"
  86               "ftp://uiarchive.cso.uiuc.edu/pub/ftp/ftp.gnu.org/gnu/"
  87               "ftp://gnu.cs.lewisu.edu/gnu/"
  88               "ftp://ftp.in-span.net/pub/mirrors/ftp.gnu.org/"
  89               "ftp://gnu.ms.uky.edu/pub/mirrors/gnu/"
  90               "ftp://ftp.algx.net/pub/gnu/"
  91               "ftp://aeneas.mit.edu/pub/gnu/"
  92               "ftp://ftp.egr.msu.edu/pub/gnu/"
  93               "ftp://ftp.wayne.edu/pub/gnu/"
  94               "ftp://wuarchive.wustl.edu/mirrors/gnu/"
  95               "ftp://gnu.teleglobe.net/ftp.gnu.org/"
  96               "ftp://ftp.cs.columbia.edu/archives/gnu/prep/"
  97               "ftp://ftp.ece.cornell.edu/pub/mirrors/gnu/"
  98               "ftp://ftp.ibiblio.org/pub/mirrors/gnu/"
  99               "ftp://ftp.cis.ohio-state.edu/mirror/gnu/"
 100               "ftp://ftp.club.cc.cmu.edu/gnu/"
 101               "ftp://ftp.sunsite.utk.edu/pub/gnu/ftp/"
 102               "ftp://thales.memphis.edu/pub/gnu/"
 103               "ftp://gnu.wwc.edu"
 104               "ftp://ftp.twtelecom.net/pub/GNU/"
 105               ;; Africa
 106               "ftp://ftp.sun.ac.za/mirrorsites/ftp.gnu.org"
 107               ;; The Americas
 108               "ftp://ftp.unicamp.br/pub/gnu/"
 109               "ftp://master.softaplic.com.br/pub/gnu/"
 110               "ftp://ftp.matrix.com.br/pub/gnu/"
 111               "ftp://ftp.pucpr.br/gnu"
 112               "ftp://ftp.linorg.usp.br/gnu"
 113               "ftp://ftp.cs.ubc.ca/mirror2/gnu/"
 114               "ftp://cs.ubishops.ca/pub/ftp.gnu.org/"
 115               "ftp://ftp.inf.utfsm.cl/pub/gnu/"
 116               "ftp://sunsite.ulatina.ac.cr/Mirrors/GNU/"
 117               "ftp://www.gnu.unam.mx/pub/gnu/software/"
 118               "ftp://gnu.cem.itesm.mx/pub/mirrors/gnu.org/"
 119               "ftp://ftp.azc.uam.mx/mirrors/gnu/"
 120               ;; Australia
 121               "ftp://mirror.aarnet.edu.au/pub/gnu/"
 122               "ftp://gnu.mirror.pacific.net.au/gnu/"
 123               ;; Asia
 124               "ftp://ftp.cs.cuhk.edu.hk/pub/gnu/gnu/"
 125               "ftp://sunsite.ust.hk/pub/gnu/"
 126               "ftp://ftp.gnupilgrims.org/pub/gnu"
 127               "ftp://www.imtech.res.in/mirror/gnuftp/"
 128               "ftp://kambing.vlsm.org/gnu"
 129               "ftp://ftp.cs.huji.ac.il/mirror/GNU/"
 130               "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/"
 131               "ftp://core.ring.gr.jp/pub/GNU/"
 132               "ftp://ftp.ring.gr.jp/pub/GNU/"
 133               "ftp://mirrors.hbi.co.jp/gnu/"
 134               "ftp://ftp.cs.titech.ac.jp/pub/gnu/"
 135               "ftp://ftpmirror.hanyang.ac.kr/GNU/"
 136               "ftp://ftp.linux.sarang.net/mirror/gnu/gnu/"
 137               "ftp://ftp.xgate.co.kr/pub/mirror/gnu/"
 138               "ftp://ftp://gnu.xinicks.com/"
 139               "ftp://ftp.isu.net.sa/pub/gnu/"
 140               "ftp://ftp.nctu.edu.tw/UNIX/gnu/"
 141               "ftp://coda.nctu.edu.tw/UNIX/gnu/"
 142               "ftp://ftp1.sinica.edu.tw/pub3/GNU/gnu/"
 143               "ftp://gnu.cdpa.nsysu.edu.tw/gnu"
 144               "ftp://ftp.nectec.or.th/pub/mirrors/gnu/"
 145               ;; Europe
 146               "ftp://ftp.gnu.vbs.at/"
 147               "ftp://ftp.univie.ac.at/packages/gnu/"
 148               "ftp://gd.tuwien.ac.at/gnu/gnusrc/"
 149               "ftp://ftp.belnet.be/mirror/ftp.gnu.org/"
 150               "ftp://gnu.blic.net/pub/gnu/"
 151               "ftp://ftp.fi.muni.cz/pub/gnu/"
 152               "ftp://ftp.dkuug.dk/pub/gnu/"
 153               "ftp://sunsite.dk/mirrors/gnu"
 154               "ftp://ftp.funet.fi/pub/gnu/prep/"
 155               "ftp://ftp.irisa.fr/pub/gnu/"
 156               "ftp://ftp.cs.univ-paris8.fr/mirrors/ftp.gnu.org/"
 157               "ftp://ftp.cs.tu-berlin.de/pub/gnu/"
 158               "ftp://ftp.leo.org/pub/comp/os/unix/gnu/"
 159               "ftp://ftp.informatik.rwth-aachen.de/pub/gnu/"
 160               "ftp://ftp.de.uu.net/pub/gnu/"
 161               "ftp://ftp.freenet.de/pub/ftp.gnu.org/gnu/"
 162               "ftp://ftp.cs.uni-bonn.de/pub/gnu/"
 163               "ftp://ftp-stud.fht-esslingen.de/pub/Mirrors/ftp.gnu.org/"
 164               "ftp://ftp.stw-bonn.de/pub/mirror/ftp.gnu.org/"
 165               "ftp://ftp.math.uni-bremen.de/pub/gnu"
 166               "ftp://ftp.forthnet.gr/pub/gnu/"
 167               "ftp://ftp.ntua.gr/pub/gnu/"
 168               "ftp://ftp.duth.gr/pub/gnu/"
 169               "ftp://ftp.physics.auth.gr/pub/gnu/"
 170               "ftp://ftp.esat.net/pub/gnu/"
 171               "ftp://ftp.heanet.ie/mirrors/ftp.gnu.org"
 172               "ftp://ftp.lugroma2.org/pub/gnu/"
 173               "ftp://ftp.gnu.inetcosmos.org/pub/gnu/"
 174               "ftp://ftp.digitaltrust.it/pub/gnu"
 175               "ftp://ftp://rm.mirror.garr.it/mirrors/gnuftp"
 176               "ftp://ftp.nluug.nl/pub/gnu/"
 177               "ftp://ftp.mirror.nl/pub/mirror/gnu/"
 178               "ftp://ftp.nl.uu.net/pub/gnu/"
 179               "ftp://mirror.widexs.nl/pub/gnu/"
 180               "ftp://ftp.easynet.nl/mirror/GNU/"
 181               "ftp://ftp.win.tue.nl/pub/gnu"
 182               "ftp://gnu.mirror.vuurwerk.net/pub/GNU/"
 183               "ftp://gnu.kookel.org/pub/ftp.gnu.org/"
 184               "ftp://ftp.uninett.no/pub/gnu/"
 185               "ftp://ftp.task.gda.pl/pub/gnu/"
 186               "ftp://sunsite.icm.edu.pl/pub/gnu/"
 187               "ftp://ftp.man.poznan.pl/pub/gnu"
 188               "ftp://ftp.ist.utl.pt/pub/GNU/gnu/"
 189               "ftp://ftp.telepac.pt/pub/gnu/"
 190               "ftp://ftp.timisoara.roedu.net/mirrors/ftp.gnu.org/pub/gnu"
 191               "ftp://ftp.chg.ru/pub/gnu/"
 192               "ftp://gnuftp.axitel.ru/"
 193               "ftp://ftp.arnes.si/software/gnu/"
 194               "ftp://ftp.etsimo.uniovi.es/pub/gnu/"
 195               "ftp://ftp.rediris.es/pub/gnu/"
 196               "ftp://ftp.chl.chalmers.se/pub/gnu/"
 197               "ftp://ftp.isy.liu.se/pub/gnu/"
 198               "ftp://ftp.luth.se/pub/unix/gnu/"
 199               "ftp://ftp.stacken.kth.se/pub/gnu/"
 200               "ftp://ftp.sunet.se/pub/gnu/"
 201               "ftp://sunsite.cnlab-switch.ch/mirror/gnu/"
 202               "ftp://ftp.ulak.net.tr/gnu/"
 203               "ftp://ftp.gnu.org.ua"
 204               "ftp://ftp.mcc.ac.uk/pub/gnu/"
 205               "ftp://ftp.mirror.ac.uk/sites/ftp.gnu.org/gnu/"
 206               "ftp://ftp.warwick.ac.uk/pub/gnu/"
 207               "ftp://ftp.hands.com/ftp.gnu.org/"
 208               "ftp://gnu.teleglobe.net/ftp.gnu.org/"])
 209     ("GNU Project Home Page" . "www.gnu.org")
 210
 211     ;; Emacs.
 212     ("Emacs Home Page" .
 213      "www.gnu.org/software/emacs/emacs.html")
 214     ("Savannah Emacs page" .
 215      "savannah.gnu.org/projects/emacs")
 216     ("Emacs Lisp List" .
 217      "www.damtp.cam.ac.uk/user/eglen/emacs/ell.html")
 218     ("Emacs Wiki" .
 219      [simple-query "www.emacswiki.org"
 220                    "www.emacswiki.org/cgi-bin/wiki/" ""])
 221
 222     ;; Internet search engines.
 223     ("Google" .
 224      [simple-query "www.google.com"
 225                    "www.google.com/search?q=" ""])
 226     ("Google Groups" .
 227      [simple-query "groups.google.com"
 228                    "groups.google.com/groups?q=" ""])
 229     ("Yahoo" .
 230      [simple-query "www.yahoo.com" "search.yahoo.com/search?p=" ""])
 231     ("Yahoo: Reference" . "www.yahoo.com/Reference/")
 232
 233     ("Wikipedia" .
 234      [simple-query "wikipedia.org" "wikipedia.org/wiki/" ""])
 235
 236     ;; Misc. general interest.
 237     ("Interactive Weather Information Network" . webjump-to-iwin)
 238     ("Usenet FAQs" .
 239      "www.faqs.org/faqs/")
 240     ("RTFM Usenet FAQs by Group" .
 241      "ftp://rtfm.mit.edu/pub/usenet-by-group/")
 242     ("RTFM Usenet FAQs by Hierachy" .
 243      "ftp://rtfm.mit.edu/pub/usenet-by-hierarchy/")
 244     ("X Consortium Archive" . "ftp.x.org")
 245
 246     ;; Computer social issues, privacy, professionalism.
 247     ("Association for Computing Machinery" . "www.acm.org")
 248     ("Computer Professionals for Social Responsibility" . "www.cpsr.org")
 249     ("Electronic Frontier Foundation" . "www.eff.org")
 250     ("IEEE Computer Society" . "www.computer.org")
 251     ("Risks Digest" . webjump-to-risks)
 252
 253     ;; More.
 254     ("Supplemental Web site list for webjump" .
 255      "www.neilvandyke.org/webjump/")
 256
 257     )
 258   "Sample hotlist for WebJump.  See the documentation for the `webjump'
 259 function and the `webjump-sites' variable.")
 260
 261 (defvar webjump-state-to-postal-alist
 262   '(("Alabama" . "al") ("Alaska" . "ak") ("Arizona" . "az") ("Arkansas" . "ar")
 263     ("California" . "ca") ("Colorado" . "co") ("Connecticut" . "ct")
 264     ("Delaware" . "de") ("Florida" . "fl") ("Georgia" . "ga") ("Hawaii" . "hi")
 265     ("Idaho" . "id") ("Illinois" . "il") ("Indiana" . "in") ("Iowa" . "ia")
 266     ("Kansas" . "ks") ("Kentucky" . "ky") ("Louisiana" . "la") ("Maine" . "me")
 267     ("Maryland" . "md") ("Massachusetts" . "ma") ("Michigan" . "mi")
 268     ("Minnesota" . "mn") ("Mississippi" . "ms") ("Missouri" . "mo")
 269     ("Montana" . "mt") ("Nebraska" . "ne") ("Nevada" . "nv")
 270     ("New Hampshire" . "nh") ("New Jersey" . "nj") ("New Mexico" . "nm")
 271     ("New York" . "ny") ("North Carolina" . "nc") ("North Dakota" . "nd")
 272     ("Ohio" . "oh") ("Oklahoma" . "ok") ("Oregon" . "or")
 273     ("Pennsylvania" . "pa") ("Rhode Island" . "ri") ("South Carolina" . "sc")
 274     ("South Dakota" . "sd") ("Tennessee" . "tn") ("Texas" . "tx")
 275     ("Utah" . "ut") ("Vermont" . "vt") ("Virginia" . "va")
 276     ("Washington" . "wa") ("West Virginia" . "wv") ("Wisconsin" . "wi")
 277     ("Wyoming" . "wy")))
 278
 279 ;;------------------------------------------------------------ Option Variables
 280
 281 (defvar webjump-sites
 282   webjump-sample-sites
 283   "*Hotlist for WebJump.
 284
 285 The hotlist is represented as an association list, with the CAR of each cell
 286 being the name of the Web site, and the CDR being the definition for the URL of
 287 that site.  The URL definition can be a string (the URL), a vector (specifying
 288 a special \"builtin\" which returns a URL), a symbol (name of a function which
 289 returns a URL), or a list (which when `eval'ed yields a URL).
 290
 291 If the URL definition is a vector, then a \"builtin\" is used.  A builtin has a
 292 Lisp-like syntax, with the name as the first element of the vector, and any
 293 arguments as the following elements.  The three current builtins are `name',
 294 which returns the name of the site as the URL, `simple-query', which
 295 returns a URL that is a function of a query entered by the user, and `mirrors',
 296 which allows the user to select from among multiple mirror sites for the same
 297 content.
 298
 299 The first argument to the `simple-query' builtin is a static URL to use if the
 300 user enters a blank query.  The second and third arguments are the prefix and
 301 suffix, respectively, to add to the encoded query the user enters.  This
 302 builtin covers Web sites that have single-string searches with the query
 303 embedded in the URL.
 304
 305 The arguments to the `mirrors' builtin are URLs of mirror sites.
 306
 307 If the symbol of a function is given, then the function will be called with the
 308 Web site name (the one you specified in the CAR of the alist cell) as a
 309 parameter.  This might come in handy for various kludges.
 310
 311 For convenience, if the `http://', `ftp://', or `file://' prefix is missing
 312 from a URL, WebJump will make a guess at what you wanted and prepend it before
 313 submitting the URL.")
 314
 315 ;;------------------------------------------------------- Sample Site Functions
 316
 317 (defun webjump-to-iwin (name)
 318   (let ((prefix "http://iwin.nws.noaa.gov/")
 319         (state (webjump-read-choice name "state"
 320                                     (append '(("Puerto Rico" . "pr"))
 321                                             webjump-state-to-postal-alist))))
 322     (if state
 323         (concat prefix "iwin/" state "/"
 324                 (webjump-read-choice name "option"
 325                                      '(("Hourly Report" . "hourly")
 326                                        ("State Forecast" . "state")
 327                                        ("Local Forecast" . "local")
 328                                        ("Zone Forecast" . "zone")
 329                                        ("Short-Term Forecast" . "shortterm")
 330                                        ("Weather Summary" . "summary")
 331                                        ("Public Information" . "public")
 332                                        ("Climatic Data" . "climate")
 333                                        ("Aviation Products" . "aviation")
 334                                        ("Hydro Products" . "hydro")
 335                                        ("Special Weather" . "special")
 336                                        ("Watches and Warnings" . "warnings"))
 337                                      "zone")
 338                 ".html")
 339       prefix)))
 340
 341 (defun webjump-to-risks (name)
 342   (let (issue volume)
 343     (if (and (setq volume (webjump-read-number (concat name " volume")))
 344              (setq issue  (webjump-read-number (concat name " issue"))))
 345         (format "catless.ncl.ac.uk/Risks/%d.%02d.html" volume issue)
 346       "catless.ncl.ac.uk/Risks/")))
 347
 348 ;;-------------------------------------------------------------- Core Functions
 349
 350 ;;;###autoload
 351 (defun webjump ()
 352   "Jumps to a Web site from a programmable hotlist.
 353
 354 See the documentation for the `webjump-sites' variable for how to customize the
 355 hotlist.
 356
 357 Please submit bug reports and other feedback to the author, Neil W. Van Dyke
 358 <nwv@acm.org>."
 359   (interactive)
 360   (let* ((completion-ignore-case t)
 361          (item (assoc-string
 362                 (completing-read "WebJump to site: " webjump-sites nil t)
 363                 webjump-sites t))
 364          (name (car item))
 365          (expr (cdr item)))
 366     (browse-url (webjump-url-fix
 367                  (cond ((not expr) "")
 368                        ((stringp expr) expr)
 369                        ((vectorp expr) (webjump-builtin expr name))
 370                        ((listp expr) (eval expr))
 371                        ((symbolp expr)
 372                         (if (fboundp expr)
 373                             (funcall expr name)
 374                           (error "WebJump URL function \"%s\" undefined"
 375                                  expr)))
 376                        (t (error "WebJump URL expression for \"%s\" invalid"
 377                                  name)))))))
 378
 379 (defun webjump-builtin (expr name)
 380   (if (< (length expr) 1)
 381       (error "WebJump URL builtin for \"%s\" empty" name))
 382   (let ((builtin (aref expr 0)))
 383     (cond
 384      ((eq builtin 'mirrors)
 385       (if (= (length expr) 1)
 386           (error
 387            "WebJump URL builtin \"mirrors\" for \"%s\" needs at least 1 arg"
 388            name))
 389       (webjump-choose-mirror name (cdr (append expr nil))))
 390      ((eq builtin 'name)
 391       name)
 392      ((eq builtin 'simple-query)
 393       (webjump-builtin-check-args expr name 3)
 394       (webjump-do-simple-query name (aref expr 1) (aref expr 2) (aref expr 3)))
 395      (t (error "WebJump URL builtin \"%s\" for \"%s\" invalid"
 396                builtin name)))))
 397
 398 (defun webjump-builtin-check-args (expr name count)
 399   (or (= (length expr) (1+ count))
 400       (error "WebJump URL builtin \"%s\" for \"%s\" needs %d args"
 401              (aref expr 0) name count)))
 402
 403 (defun webjump-choose-mirror (name urls)
 404   (webjump-read-url-choice (concat name " mirror")
 405                            urls
 406                            (webjump-mirror-default urls)))
 407
 408 (defun webjump-do-simple-query (name noquery-url query-prefix query-suffix)
 409   (let ((query (webjump-read-string (concat name " query"))))
 410     (if query
 411         (concat query-prefix (webjump-url-encode query) query-suffix)
 412       noquery-url)))
 413
 414 (defun webjump-mirror-default (urls)
 415   ;; Note: This should be modified to apply some simple kludges/heuristics to
 416   ;; pick a site which is likely "close".  As a tie-breaker among candidates
 417   ;; judged equally desirable, randomness might be used.
 418   (car urls))
 419
 420 (defun webjump-read-choice (name what choices &optional default)
 421   (let* ((completion-ignore-case t)
 422          (choice (completing-read (concat name " " what ": ") choices nil t)))
 423     (if (webjump-null-or-blank-string-p choice)
 424         default
 425       (cdr (assoc choice choices)))))
 426
 427 (defun webjump-read-number (prompt)
 428   ;; Note: I should make this more robust someday.
 429   (let ((input (webjump-read-string prompt)))
 430     (if input (string-to-number input))))
 431
 432 (defun webjump-read-string (prompt)
 433   (let ((input (read-string (concat prompt ": "))))
 434     (if (webjump-null-or-blank-string-p input) nil input)))
 435
 436 (defun webjump-read-url-choice (what urls &optional default)
 437   ;; Note: Convert this to use `webjump-read-choice' someday.
 438   (let* ((completions (mapcar (function (lambda (n) (cons n n)))
 439                               urls))
 440          (input (completing-read (concat what
 441                                          ;;(if default " (RET for default)" "")
 442                                          ": ")
 443                                  completions
 444                                  nil
 445                                  t)))
 446     (if (webjump-null-or-blank-string-p input)
 447         default
 448       (car (assoc input completions)))))
 449
 450 (defun webjump-null-or-blank-string-p (str)
 451   (or (null str) (string-match "^[ \t]*$" str)))
 452
 453 (defun webjump-url-encode (str)
 454   (mapconcat '(lambda (c)
 455                 (cond ((= c 32) "+")
 456                       ((or (and (>= c ?a) (<= c ?z))
 457                            (and (>= c ?A) (<= c ?Z))
 458                            (and (>= c ?0) (<= c ?9)))
 459                        (char-to-string c))
 460                       (t (upcase (format "%%%02x" c)))))
 461              str
 462              ""))
 463
 464 (defun webjump-url-fix (url)
 465   (if (webjump-null-or-blank-string-p url)
 466       ""
 467     (webjump-url-fix-trailing-slash
 468      (cond
 469       ((string-match "^[a-zA-Z]+:" url) url)
 470       ((string-match "^/" url) (concat "file://" url))
 471       ((string-match "^\\([^\\./]+\\)" url)
 472        (concat (if (string= (downcase (match-string 1 url)) "ftp")
 473                    "ftp"
 474                  "http")
 475                "://"
 476                url))
 477       (t url)))))
 478
 479 (defun webjump-url-fix-trailing-slash (url)
 480   (if (string-match "^[a-zA-Z]+://[^/]+$" url)
 481       (concat url "/")
 482     url))
 483
 484 ;;-----------------------------------------------------------------------------
 485
 486 (provide 'webjump)
 487
 488 ;;; arch-tag: f1d20156-0a6f-488b-bd91-f69ee8b6d5cc
 489 ;;; webjump.el ends here