code.delx.au - gnu-emacs-elpa/blob - packages/notes-mode/notes-url.el

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