Package: emacs-goodies-el Version: 26.4-1 Severity: wishlist Tags: patch I'm surprised rfcview.el is included, as Debian considers the RFCs non-free but, here's a patch to make it more useful by hyperlinking internal and external stuff.
2006-07-08 Dave Love <[EMAIL PROTECTED]> * rfcview.el: Doc and error string fixes. (easymenu): Don't require. (rfcview-mode-map): Define in defvar. (rfcview-remove-all-markers): Remove (and calls). (rfcview-make-marker): Remove and just use positions instead of calling this. (rfcview-grok-buffer): Hyperlink contents, references and URLs. (rfcview-reflink-ovlcat, rfcview-rfcurl-ovlcat): New category. (goto-addr): Require. (rfcview-mouseover-face): Just inherit from highlight. (rfcview-stock-section-names): Add informative/normative references. (rfcview-link-add-headlink-for): Fixed. (rfcview-hyperlink-contents, rfcview-link-map) (rfcview-overriding-map, rfcview-maybe-goto-header) (rfcview-goto-link, rfcview-goto-link-mouse) (rfcview-imenu-index-function, rfcview-ref-alist) (rfcview-hyperlink-refs, rfcview-browse-url-of-rfc) (rfcview-browse-url-of-rfc-mouse, rfcview-rfc-keymap) (rfcview-next-button): New. (rfcview-mode): Set minor-mode-map-alist, imenu-sort-function, imenu-create-index-function locally. Simplify view-mode-enter call. Call imenu-add-to-menubar. Make rfcview-ref-alist buffer-local. (rfcview-quit): Add optional arg. (rfcview-headlink-ovlcat): Add keymap. --- rfcview.el 2006-07-10 11:32:30.000000000 +0100 +++ rfcview.el 2006-07-10 11:32:30.000000000 +0100 @@ -1,9 +1,11 @@ ;;; rfcview.el -- view IETF RFCs with readability-improved formatting ;; Copyright (C) 2001-2002 Neil W. Van Dyke +;; Copyright (C) 2006 Free Software Foundation, Inc. +;; (mods by Dave Love <[EMAIL PROTECTED]>) ;; Author: Neil W. Van Dyke <[EMAIL PROTECTED]> -;; Version: 0.5 +;; Version: 0.6 ;; X-URL: http://www.neilvandyke.org/rfcview/ ;; X-CVS: $Id: rfcview.el,v 1.25 2002/10/16 00:56:23 nwv Exp $ GMT @@ -54,7 +56,8 @@ ;; 3. Restart Emacs. The next time you visit an RFC file, it should be ;; displayed prettily using `rfcview-mode'. ;; -;; 4. Optionally, do `M-x rfcview-customize RET' to +;; 4. Optionally, do `M-x rfcview-customize RET' to customize the mode +;; options. ;; Things for the Author to Someday Do (but Probably Not): ;; @@ -70,17 +73,9 @@ ;; * Handle "Table of Contents" heading centered, such as in RFC 1035 and RFC ;; 1157. ;; -;; * Add hyperlinks to TOC entries. -;; -;; * Build popup TOC navigation menu. -;; -;; * Make hyperlinks for bibliographic references. Display in other-window +;; * Display bibliographic references in other-window ;; vertically-sized to fit only the reference (or min window height). ;; -;; * Maybe make hyperlinks for urls (but not email addrs). -;; -;; * Make hyperlinks to referenced RFCs. -;; ;; * Download RFCs on demand, and cache them. Probably integrate one of the ;; existing one or two packages that do this. ;; @@ -93,6 +88,8 @@ ;;; CHANGE LOG: +;; [Version 0.6, 2006-07-07] Hyperlinking (Dave Love). +;; ;; [Version 0.5, 15-Oct-2002] Updated email address. ;; ;; [Version 0.4, 26-Feb-2002] @@ -120,7 +117,7 @@ ;;; CODE: -(require 'easymenu) +(require 'goto-addr) ;; Customization: @@ -139,6 +136,12 @@ :group 'rfcview :type 'boolean) +(defcustom rfcview-rfc-url-pattern "http://www.ietf.org/rfc/rfc%s.txt"; + "Pattern to generate the URL for a numbered RFC. +Must contain a single `%s' to be substituted with the RFC's number." + :type 'string + :group 'rfcview) + (defface rfcview-title-face '((t (:bold t))) "Face used for titles." @@ -161,8 +164,7 @@ :group 'rfcview) (defface rfcview-mouseover-face - '((((class color)) (:foreground "white" :background "blue" :bold t)) - (t (:inverse-video t))) + '((t (:inherit highlight))) "Face used for mousing over a hyperlink." :group 'rfcview) @@ -180,7 +182,18 @@ (defvar rfcview-debug-show-hidden-p nil) -(defvar rfcview-mode-map nil) +(defvar rfcview-mode-map + (let ((km (make-sparse-keymap))) + (define-key km "t" 'rfcview-textmode) + (define-key km "q" 'rfcview-quit) + (define-key km "\t" 'rfcview-next-button) + (easy-menu-define rfcview-mode-menu km + "Menu for RFCview." + '("RFCview" + ["Quit" rfcview-quit t] + ["Text Mode" rfcview-textmode t] + ["Next Button" rfcview-next-button t])) + km)) (defvar rfcview-stock-section-names '("abstract" @@ -206,7 +219,9 @@ "references" "security considerations" "status of this memo" - "table of contents")) + "table of contents" + "informative references" + "normative references")) (defvar rfcview-headlink-ovlcat nil) (defvar rfcview-headname-ovlcat nil) @@ -219,6 +234,9 @@ (defvar rfcview-local-heading-alist nil) +(defvar rfcview-ref-alist nil + "Alist of RFC references `(<reference> . <position>)'.") + ;; Functions: (defun rfcview-add-overlay (begin end category) @@ -229,10 +247,12 @@ ;;;###autoload (defun rfcview-customize () + "Enter the RFCview Custom group." (interactive) (customize-group 'rfcview)) (defun rfcview-grok-buffer () + "Add overlays to the buffer to modify its presentation." (interactive) (let ((case-fold-search nil) (top-point (point-min)) @@ -240,7 +260,6 @@ ;; Clean up everything. (rfcview-remove-all-overlays) - (rfcview-remove-all-markers) (make-local-variable 'rfcview-local-heading-alist) (setq rfcview-local-heading-alist '()) @@ -290,7 +309,7 @@ (let ((n (string-to-number (match-string 3)))) (if (= n 0) "?" (1+ n)))))) (overlay-put overlay - 'before-string + 'before-string (concat (make-string (max (- 79 (- (match-beginning 1) (match-beginning 0)) @@ -305,7 +324,7 @@ (unless (re-search-forward (concat "^[ \t]*\r?\n" "\\(\\([ \t]*\r?\n\\)+\\)?") nil t) - (error "This doesn't seem to be an RFC - no blank line before title.")) + (error "This doesn't seem to be an RFC - no blank line before title")) (when (match-beginning 1) (rfcview-hide-region (match-beginning 1) (match-end 1))) (setq title-line-point (point)) @@ -393,7 +412,7 @@ name-match 12) (setq num-highlight-begin (match-beginning 9) num-highlight-end (match-end 11))) - (t (error "this should never happen"))) + (t (error "This should never happen"))) ;; Add overlays. (when num-match @@ -414,12 +433,23 @@ (vector num name - (rfcview-make-marker (match-beginning 0)) - (rfcview-make-marker (match-end 0)))) + (match-beginning 0) + (match-end 0))) rfcview-local-heading-alist)))))) ;; Reverse `rfcview-local-heading-alist'. (setq rfcview-local-heading-alist (nreverse rfcview-local-heading-alist)) + ;; Hyperlink the contents and references + (rfcview-hyperlink-contents) + (rfcview-hyperlink-refs) + + ;; Hyperlink URLs. `goto-address-fontify-maximum-size' is only + ;; 30000 by default. + (let ((goto-address-fontify-maximum-size (point-max)) + (goto-address-highlight-p t) + (goto-address-mail-regexp "\\<\\>")) ; don't match emails + (goto-address)) + ;; Leave the point at the visible top of the buffer. (goto-char top-point)) @@ -428,20 +458,152 @@ (defun rfcview-hide-region (start end) (rfcview-add-overlay start end 'rfcview-hide-ovlcat)) -(defun rfcview-link-add-headlink (start end marker) +;; Hyperlinking + +(defun rfcview-imenu-index-function () + "`imenu-create-index-function' for RFCview." + (mapcar (lambda (elt) + (setq elt (cdr elt)) + (let ((num (aref elt 0)) + (head (aref elt 1)) + (pos (aref elt 2))) + (cons (if num + (concat num " " head) + head) + pos))) + rfcview-local-heading-alist)) + +(defun rfcview-link-add-headlink (start end pos) (let ((overlay (rfcview-add-overlay start end 'rfcview-headlink-ovlcat))) - (overlay-put overlay 'rfcview-link (list 'head marker)) + (overlay-put overlay 'rfcview-link (list 'head pos)) overlay)) (defun rfcview-link-add-headlink-for (start end key) - (let ((vec (cdr (member (downcase key) rfcview-local-heading-alist)))) + (let ((vec (cdr (assoc (downcase key) rfcview-local-heading-alist)))) (when vec (rfcview-link-add-headlink start end (aref vec 2))))) -(defun rfcview-make-marker (pt) - (let ((marker (make-marker))) - (set-marker marker pt) - marker)) +(defun rfcview-hyperlink-contents () + "Find table of contents and hyperlink the entries to headers." + (let* ((elt (assoc "table of contents" rfcview-local-heading-alist)) + (start (if elt (aref (cdr elt) 3))) + (next (cadr (member elt rfcview-local-heading-alist))) + (end (if next (aref (cdr next) 2))) + (case-fold-search t)) + (when (and start end) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (dolist (elt rfcview-local-heading-alist) + (let ((key (car elt))) + (when (re-search-forward (concat "^ *\\(" (regexp-quote key) + "\\) ") + nil t) + (rfcview-link-add-headlink-for (match-beginning 1) + (line-end-position) + key) + (end-of-line))))))))) + +(defvar rfcview-link-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] #'rfcview-goto-link-mouse) + map) + "Keymap for use on link overlays.") + +(defvar rfcview-overriding-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-m" #'rfcview-maybe-goto-link) + map) + "Keymap binding RET to override the View mode binding.") + +(defun rfcview-maybe-goto-link () + "Follow link if on one, else use normal binding of RET. +Push mark if on a link." + (interactive) + (or (rfcview-goto-link) + (rfcview-browse-url-of-rfc) + (let ((minor-mode-map-alist (cdr minor-mode-map-alist))) + (call-interactively (key-binding [?\C-m]))))) + +(defun rfcview-goto-link () + "If on a link, go to target, push mark, and return non-nil. +Else return nil." + (interactive) + (let ((pos (cadr (get-char-property (point) 'rfcview-link)))) + (when pos + (push-mark) + (goto-char pos)))) + +(defun rfcview-goto-link-mouse (event) + "Follow a link selected with the mouse EVENT and push mark." + (interactive "e") + (mouse-set-point event) + (rfcview-goto-link)) + +(defun rfcview-hyperlink-refs () + "Find references in appropriate sections and hyperlink them from elsewhere." + (save-excursion + ;; Find the references sections, including `Normative + ;; references' &c. + (dolist (elt rfcview-local-heading-alist) + (when (let ((case-fold-search t)) + (string-match "\\<\\(?:references\\|bibliography\\)\\'" + (aref (cdr elt) 1))) + (let* ((start (aref (cdr elt) 3)) + (next (cadr (member elt rfcview-local-heading-alist))) + (end (if next + (aref (cdr next) 2) + (point-max))) + (case-fold-search nil)) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + ;; Look for plausible-looking tags (with uppercase + ;; letters, numbers or hyphens withing brackets). + (while (re-search-forward "^ *\\([[][-A-Z0-9]+]\\) " nil t) + (push (cons (match-string 1) (match-beginning 1)) + rfcview-ref-alist) + ;; If it look like an RFC reference, hyperlink it. + (let ((start (match-beginning 1)) + (end (match-end 1)) + (string (match-string 1))) + (when (string-match "[[]RFC\\([0-9]+\\)]" (match-string 1)) + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'category 'rfcview-rfcurl-ovlcat) + (overlay-put overlay + 'url (format rfcview-rfc-url-pattern + (match-string 1 string))))))))))) + ;; Find and activate references in the body. Skip if it's at the + ;; position of a target. + (goto-char (point-min)) + (while (re-search-forward "\\([[][-A-Z0-9]+]\\)" nil t) + (let ((elt (assoc (match-string 1) rfcview-ref-alist))) + (when (and elt (/= (match-beginning 1) (cdr elt))) + (overlay-put (rfcview-add-overlay (match-beginning 1) (match-end 1) + 'rfcview-headlink-ovlcat) + 'rfcview-link (list 'ref (cdr elt)))))))) + +(defun rfcview-browse-url-of-rfc () + "Browse to the URL of nay RFC referenced at point." + (interactive) + (let ((url (get-char-property (point) 'url))) + (if url (browse-url url)))) + +(defun rfcview-browse-url-of-rfc-mouse (event) + "Browse to the URL of the RFC reference at the mouse EVENT." + (interactive) + (save-excursion + (mouse-set-point event) + (browse-url (get-char-property (point) 'url)))) + +(defvar rfcview-rfc-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] #'rfcview-browse-url-of-rfc-mouse) + map) + "Keymap for links to RFC URLs.") + +;; Major mode ;;;###autoload (defun rfcview-mode () @@ -459,9 +621,19 @@ (make-local-variable 'font-lock-defaults) (make-local-variable 'rfcview-local-heading-alist) (setq font-lock-defaults nil) + (make-local-variable 'minor-mode-map-alist) + ;; Arrange to lose the C-m binding from View mode: + (push (cons t rfcview-overriding-map) minor-mode-map-alist) + (set (make-local-variable 'imenu-create-index-function) + 'rfcview-imenu-index-function) + (set (make-local-variable 'imenu-sort-function) nil) + (make-local-variable 'rfcview-ref-alist) (when rfcview-use-view-mode-p - (view-mode-enter nil (function (lambda (buf) (rfcview-quit))))) + (view-mode-enter nil #'rfcview-quit)) (rfcview-grok-buffer) + ;; This is easier and probably better than inserting contents in the + ;; mode menu. + (imenu-add-to-menubar "Contents") (run-hooks 'rfcview-mode-hook)) (defun rfcview-put-alist (symbol alist) @@ -469,14 +641,12 @@ (put symbol (nth 0 cell) (cdr cell)))) alist)) -(defun rfcview-quit () +(defun rfcview-quit (&optional buffer) + "Kill the RFCview buffer. +Arg BUFFER is ignored." (interactive) (kill-buffer (current-buffer))) -(defun rfcview-remove-all-markers () - ;; TODO: - ) - (defun rfcview-remove-all-overlays () (mapcar (function (lambda (lst) (while lst @@ -486,30 +656,21 @@ (list (car lists) (cdr lists))))) (defun rfcview-textmode () + "Remove overlays from the buffer and put it into Text mode." (interactive) (rfcview-remove-all-overlays) - (rfcview-remove-all-markers) (text-mode)) -;; Keymap and Menu: - -(setq rfcview-mode-map - (let ((km (make-sparse-keymap))) - (define-key km "t" 'rfcview-textmode) - (define-key km "q" 'rfcview-quit) - km)) - -(easy-menu-define rfcview-mode-menu rfcview-mode-map - "Menu for RFCview." - '("RFCview" - ["Quit" rfcview-quit t] - ["Text Mode" rfcview-textmode t] - ;;("Table of Contents" ["ERROR!" error t]) - )) +(defun rfcview-next-button () + "Move point to the next \"button\" (active link)." + (interactive) + (if (get-char-property (point) 'keymap) ; move off it + (goto-char (next-single-char-property-change (point) 'keymap))) + (goto-char (next-single-char-property-change (point) 'keymap))) ;; Overlay Categories: -(rfcview-put-alist 'rfcview-hide-ovlcat +(rfcview-put-alist 'rfcview-hide-ovlcat (if rfcview-debug-show-hidden-p '((face . region) (intangible . nil) @@ -525,8 +686,21 @@ (rfcview-put-alist 'rfcview-title-ovlcat '((face . rfcview-title-face))) (rfcview-put-alist 'rfcview-headlink-ovlcat - '((face . rfcview-headlink-face) - (mouse-face . rfcview-mouseover-face))) + `((face . rfcview-headlink-face) + (mouse-face . rfcview-mouseover-face) + (keymap . ,rfcview-link-map) + (help-echo . "mouse-2, C-m: go to this section"))) +(rfcview-put-alist 'rfcview-reflink-ovlcat + `((face . rfcview-headlink-face) + (mouse-face . rfcview-mouseover-face) + (keymap . ,rfcview-link-map) + (help-echo . "mouse-2, C-m: follow reference"))) + +(rfcview-put-alist 'rfcview-rfcurl-ovlcat + `((face . ,goto-address-url-face) + (mouse-face . ,goto-address-url-mouse-face) + (help-echo . "mouse-2, C-m: browse RFC's URL") + (keymap . ,rfcview-rfc-keymap))) ;; End:
