conf_slk120/emacs/emacs.d/emacs-lisp/notes-url.el

   1
   2 ;;;
   3 ;;; notes-url.el
   4 ;;; simplified url management routines for notes-mode
   5 ;;; $Id: notes-url.el,v 1.28 2001/05/29 21:58:58 johnh Exp $
   6 ;;;
   7 ;;; Copyright (C) 1994-1998 by John Heidemann
   8 ;;; Comments to <johnh@isi.edu>.
   9 ;;;
  10 ;;; This file is under the Gnu Public License.
  11 ;;;
  12 ;;; This code was originallly cribbed from w3.el
  13 ;;; by William M. Perry <wmperry@indiana.edu>,
  14 ;;; but has since been completely rewritten.
  15 ;;;
  16 ;;; Why don't I just call his code?  Because to use
  17 ;;; w3-follow-link I need to pull in at least 150k of w3.el
  18 ;;; and 150k of url.el, all just to open a file on the local
  19 ;;; computer.  Instead I've hacked his code down to the 3k
  20 ;;; needed for opening local files.
  21 ;;;
  22
  23 (require 'notes-variables)
  24 (require 'notes-aux)
  25
  26 (defvar notes-last-url nil
  27   "Last URL interpreted.
  28 This record is useful for debugging.")
  29
  30 ;;;###autoload
  31 (defun notes-w3-url (url &optional where best-effort)
  32   "Open a notes-url.  Handle simple URLs here, or call notes-w3-alternate-url.
  33 Takes the URL as an argument.  Optionally you specify
  34 WHERE the information should appear (either 'otherwindow or not,
  35 defaults to not).
  36 BEST-EFFORT causes notes-w3-url allows the tag portion of the URL to not
  37 match.  If there's no tag match, it looks for the nearest matching prefix.
  38
  39 URLs optionally can begin with an URL: tag, which will be ignored.
  40
  41 notes-w3-url handles only <file://localhost/...> (or <file:///...>) URLs.
  42 Other URLs it hands off to the routine in notes-w3-alternate-url
  43 for processing.  If you use w3-mode, then
  44     (setq notes-w3-alternate-url 'w3-follow-link)
  45 will have w3 handle tough URLs."
  46   (if (string-match "^[Uu][Rr][Ll]:" url)
  47       (setq url (substring url 4)))
  48   (if (not (string-match "^file://\\(localhost\\)?/\\(.*\\)$" url))
  49       (if (string-match "none" url)
  50           (error "Notes-mode can't follow URL <none>.")
  51         (funcall notes-w3-alternate-url url where)) ;; now, with where! (emacs-20.4)
  52     (let ((filetag (match-substring url 2))
  53           fname tag count count-string)
  54       ;; pick out the tag, if any
  55       (if (string-match "^\\([^#]*\\)#\\([0-9]*\\)\\(.*\\)$" filetag)
  56           (setq fname (match-substring filetag 1)
  57                 count-string (match-substring filetag 2 nil t)
  58                 count (if count-string (string-to-int count-string) 1)
  59                 tag (match-substring filetag 3))
  60         (setq fname filetag
  61               count 1
  62               tag nil))
  63       ;; Hack---url's refering to notes-index files have different tags.
  64       ;; Otherwise notes-goto-index-entry fails on subjects like "* 252A".
  65       (if (and count-string tag (string-match "/index$" fname))
  66           (setq tag (concat count-string tag)
  67                 count-string "1"
  68                 count 1))
  69       (if (not (string-match "^~" fname))   ; non-~ fnames start at fs root
  70           (setq fname (concat "/" fname)))
  71       ;; open the file
  72       (cond
  73        ((equal where 'otherwindow) (find-file-other-window fname))
  74        (t (find-file (expand-file-name fname))))
  75       ;; handle the tag
  76       (if tag
  77           (notes-w3-url-tag tag best-effort)
  78         t))))
  79
  80 (defun notes-w3-url-tag-backup (tag)
  81   "Strip the last ``part'' off of TAG."
  82   (let ((result)
  83         (separators " /\t.:")
  84         (buf (get-buffer-create " *notes-w3-url-tag-backup")))
  85     (save-excursion
  86       (set-buffer buf)
  87       (erase-buffer)
  88       (insert tag)
  89       (goto-char (point-max))
  90       (skip-chars-backward (concat "^" separators))
  91       (skip-chars-backward separators)
  92       (delete-region (point) (point-max))
  93       (setq result (buffer-string)))
  94     (kill-buffer buf)
  95     result))
  96
  97 (defun notes-w3-url-tag (tag best-effort)
  98   "Find the TAG in the current buffer according to MODE.
  99 BEST-EFFORT is either t (do prefix matching),
 100 nil find the tag exactly,
 101 or 'searching (used internally)."
 102   (cond
 103    ((not tag) nil)
 104    ((and (string= tag "") (eq best-effort 'searching)) nil)
 105    (t
 106     (goto-char (point-min))
 107     (if (re-search-forward
 108          (concat "^" (regexp-quote tag)
 109                  (if (not (eq best-effort 'searching))
 110                      (if (eq major-mode 'notes-index-mode)
 111                          ": "
 112                        "$")))
 113          (point-max) t count)
 114         t  ;; hit
 115       (if (not best-effort)
 116           (error "Cannot find tag ``%s'' in %s." tag fname))
 117       (notes-w3-url-tag (notes-w3-url-tag-backup tag) 'searching)))))
 118
 119
 120 (defun notes-w3-default-alternate-url (url &optional where)
 121   "Print an error message for a notes URL that notes-w3-url can't handle."
 122   (error "Notes-mode can't interpret URL <%s>." url))
 123
 124 (defun notes-w3-pass-through-alternate-url (url &optional where)
 125   "Pass a click event through to the old binding for notes-w3-url.
 126 Try this combination:
 127   (add-hook 'notes-mode-load-hooks
 128             (function (lambda ()
 129                         (define-key notes-mode-map [mouse-2]
 130                           'notes-w3-follow-link-mouse)
 131                         (setq notes-w3-alternate-url
 132                           'notes-w3-my-alternate-url))))"
 133   (let ((event last-input-event))
 134     (funcall (lookup-key
 135               (current-global-map)
 136               (vector (car event)))
 137              event nil)))
 138
 139 ;;;###autoload
 140 (defun notes-w3-follow-link (pt &optional where)
 141   "* Follow the URL at the point.
 142 Takes a PT to look at and a WHERE to open the URL ('otherwindow or nil).
 143 This code works hard to recognize URLs based on context information.
 144 URLs can be quoted by whitespace, beginning and end of lines,
 145 or the official < and >.
 146
 147 As a special case we also recognize (and skip) the text \"prev:\"
 148 and \"next:\" before the URL.  Notes-mode uses these fields to link
 149 entries."
 150   (interactive "d")
 151   (let*
 152       ((whitespace-regexp  "[ \t\n]")
 153        (quote-regexp whitespace-regexp)
 154        start end direction)
 155     (save-excursion
 156       ;; If we're on the URL header, skip over it so the next search works.
 157       (if (looking-at "[<A-Za-z]*:")
 158           (skip-chars-forward "<A-Za-z:"))
 159       ;; First look backwards to whitespace or beginning of line
 160       ;; followed by a url header "asdf:".
 161       (if (re-search-backward "[ \t\n][^ \t\n]+:" (get-beginning-of-line) 1)
 162           (forward-char 1)          ; whitespace bound
 163         (setq quote-regexp "\n"))   ; eoln bound
 164       ;; Handle the common case of next/prev pointers.
 165       ;; If we're on one, skip to the <> quoted URL which presumably
 166       ;; follows.  (This hack is to support a guy who doesn't use
 167       ;; the mouse and so looks up urls at the beginning of the line.)
 168       (if (looking-at "\\(prev\\|next\\):")
 169           (skip-chars-forward "^<" (get-end-of-line)))
 170       ;; Check for a quoting character.
 171       (cond
 172        ((equal (char-after (point)) ?<)
 173         (progn
 174           (setq quote-regexp ">")
 175           (forward-char 1)))
 176        ((equal (char-after (point)) ?\")
 177         (progn
 178           (setq quote-regexp "\"")
 179           (forward-char 1))))
 180       ;; Remember start of url.
 181       (setq start (point))
 182       ;; Search for end of url.
 183       (if (re-search-forward quote-regexp (get-end-of-line) 1)
 184           (forward-char -1))
 185       (setq end (point))
 186       ;; Interpret it (outside the save-excursion so we can go
 187       ;; to places in the same buffer).
 188       (setq notes-last-url (buffer-substring start end)))
 189     (notes-w3-url notes-last-url where)))
 190
 191 ;;;###autoload
 192 (defun notes-w3-follow-link-mouse (e)
 193   "* Follow the URL where the mouse is."
 194   (interactive "e")
 195   (mouse-set-point e)
 196   (notes-w3-follow-link (point) 'otherwindow))
 197
 198
 199
 200