Download
(eval-when-compile (require 'cl))
(require 'url-vars)
(require 'thingatpt)
(defgroup irfc nil
"Interface for IETF RFC documents."
:group 'edit)
(defcustom irfc-assoc-mode nil
"If non-nil, RFC documents are associated with `irfc-mode'.
Default is nil."
:type 'boolean
:set (lambda (symbol value)
(set symbol value)
(if value
(add-to-list 'auto-mode-alist
'("/rfc[0-9]+\\.txt\\'" . irfc-mode))
(remove-hook 'auto-mode-alist
'("/rfc[0-9]+\\.txt\\'" . irfc-mode))))
:group 'irfc)
(defcustom irfc-directory "~/.emacs.d/RFC/"
"The storage directory for RFC document download and search."
:type 'string
:group 'irfc)
(defcustom irfc-download-base-url "http://www.ietf.org/rfc/"
"The base URL for downloading RFC documents."
:type 'string
:group 'irfc)
(defcustom irfc-buffer-name-includes-title t
"If non-nil, buffer names for RFC documents will include the RFC title.
The format for the buffer name will be 'RFCTITLE (RFCNUM.TXT)'.
If nil, the buffer name is just RFCNUM.TXT. Default is t."
:type 'boolean
:group 'irfc)
(defcustom irfc-highlight-requirement-keywords t
"If non-nil, requirement keywords specified by
`irfc-requirement-keywords' list will be highlighted using the
face specified by `irfc-requirement-keyword-face'.
Default is t."
:type 'boolean
:group 'irfc)
(defcustom irfc-highlight-references t
"If non-nil, RFC document references specified by the
`irfc-reference-regex' regular expression will be highlighted
using the face specified by `irfc-reference-face'. Default is
t."
:type 'boolean
:group 'irfc)
(defcustom irfc-requirement-keywords '("MUST" "MUST NOT"
"REQUIRED"
"SHALL" "SHALL NOT"
"SHOULD" "SHOULD NOT"
"RECOMMENDED" "NOT RECOMMENDED"
"MAY" "OPTIONAL" "NOT")
"List of requirement keyword strings to be highlighted if
`irfc-highlight-requirement-keywords' is t."
:type '(repeat (string))
:group 'irfc)
(defface irfc-title-face
'((t (:foreground "Gold" :bold t)))
"Face used for titles."
:group 'irfc)
(defvar irfc-title-overlay nil
"Overlay for `irfc-title-face'.")
(defface irfc-head-name-face
'((t (:foreground "DarkRed" :bold t :underline t)))
"Face used for heading names."
:group 'irfc)
(defvar irfc-head-name-overlay nil
"Overlay for `irfc-head-name-face'.")
(defface irfc-head-number-face
'((t (:foreground "DarkRed" :bold t)))
"Face used for heading numbers."
:group 'irfc)
(defvar irfc-head-number-overlay nil
"Overlay for `irfc-head-number-face'.")
(defface irfc-rfc-number-face
'((t (:foreground "Green3" :bold t)))
"Face used for RFC number in the header."
:group 'irfc)
(defvar irfc-rfc-number-overlay nil
"Overlay for `irfc-rfc-number-face'.")
(defface irfc-std-number-face
'((t (:foreground "Grey" :bold t)))
"Face used for STD number in the header."
:group 'irfc)
(defvar irfc-std-number-overlay nil
"Overlay for `irfc-std-number-face'.")
(defface irfc-rfc-link-face
'((t (:foreground "Grey30" :bold t)))
"Face used for RFC link in the header."
:group 'irfc)
(defvar irfc-rfc-link-overlay nil
"Overlay for `irfc-rfc-link-face'.")
(defface irfc-table-item-face
'((t (:foreground "LawnGreen")))
"Face used for Table item."
:group 'irfc)
(defvar irfc-table-item-overlay nil
"Overlay for `irfc-table-item-face'.")
(defface irfc-requirement-keyword-face
'((t (:foreground "red1" :bold t)))
"Face used for requirement keywords."
:group 'irfc)
(defvar irfc-requirement-keyword-overlay nil
"Overlay for `irfc-requirement-keyword-face'.")
(defface irfc-reference-face
'((t (:foreground "blue1" :bold t)))
"Face used for RFC document references."
:group 'irfc)
(defvar irfc-reference-overlay nil
"Overlay for `irfc-reference-face'.")
(defvar irfc-hide-overlay nil
"Overlay for hiding whitespace or blank lines.")
(defvar irfc-page-number-overlay nil
"Overlay for page number.")
(defvar irfc-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "j") 'next-line)
(define-key map (kbd "k") 'previous-line)
(define-key map (kbd "h") 'backward-char)
(define-key map (kbd "l") 'forward-char)
(define-key map (kbd "e") 'scroll-down)
(define-key map (kbd "SPC") 'scroll-up)
(define-key map (kbd "J") 'irfc-scroll-up-one-line)
(define-key map (kbd "K") 'irfc-scroll-down-one-line)
(define-key map (kbd ",") 'end-of-buffer)
(define-key map (kbd ".") 'beginning-of-buffer)
(define-key map (kbd "T") 'irfc-render-toggle)
(define-key map (kbd "q") 'irfc-quit)
(define-key map (kbd "o") 'irfc-follow)
(define-key map (kbd "v") 'irfc-visit)
(define-key map (kbd "r") 'irfc-reference-goto)
(define-key map (kbd "f") 'irfc-head-goto)
(define-key map (kbd "F") 'irfc-head-number-goto)
(define-key map (kbd "g") 'irfc-page-goto)
(define-key map (kbd "N") 'irfc-page-next)
(define-key map (kbd "P") 'irfc-page-prev)
(define-key map (kbd ">") 'irfc-page-last)
(define-key map (kbd "<") 'irfc-page-first)
(define-key map (kbd "b") 'irfc-page-table)
(define-key map (kbd "H") 'irfc-head-next)
(define-key map (kbd "L") 'irfc-head-prev)
(define-key map (kbd "G") 'irfc-table-jump)
(define-key map (kbd "<tab>") 'irfc-rfc-link-next)
(define-key map (kbd "<backtab>") 'irfc-rfc-link-prev)
map)
"Keymap used by `irfc-mode'.")
(defvar irfc-stock-section-names
'("abstract"
"acknowledgement"
"acknowledgements"
"acknowledgment"
"acknowledgments"
"appendices"
"author's address"
"authors' addresses"
"bibliography"
"chair's address"
"copyright notice"
"copyright statement"
"editor's address"
"editors' addresses"
"full copyright notice"
"full copyright statement"
"iesg note"
"index"
"introduction"
"references and bibliography"
"references"
"security considerations"
"status of this memo"
"table of contents")
"The stock name for overlay heading.")
(defvar irfc-download-buffer nil
"Download buffer used by `url-retrieve'.
This variable is always buffer-local.")
(make-variable-buffer-local 'irfc-download-buffer)
(defvar irfc-download-url nil
"URL from which to download files.
This variable is always buffer-local.")
(make-variable-buffer-local 'irfc-download-url)
(defvar irfc-render-p t
"Render status for RFC buffer.
This variable is always buffer-local.")
(make-variable-buffer-local 'irfc-render-p)
(defvar irfc-total-pages 0
"Total number of pages in RFC buffer.
This variable is always buffer-local.")
(make-variable-buffer-local 'irfc-total-pages)
(defvar irfc-heading-names-list nil
"List of heading names in RFC buffer.
This variable is buffer-local in buffers where `irfc-mode' has
been called.")
(defvar irfc-heading-numbers-list nil
"List of heading numbers in RFC buffer.
This variable is buffer-local in buffers where `irfc-mode' has
been called.")
(defvar irfc-heading-names-table nil
"Table mapping heading names to position in RFC buffer.
This variable is buffer-local in buffers where `irfc-mode' has
been called.")
(defvar irfc-heading-numbers-table nil
"Table mapping heading numbers to position in RFC buffer.
This variable is buffer-local in buffers where `irfc-mode' has
been called.")
(defvar irfc-last-visit-number nil
"Number of the last RFC document visited.")
(defvar irfc-table-regex "^[ ]+\\([A-Z]?[0-9\\.]*\\)[ ]+\\([^\\.\n]+\\)[\\. ]+\\([0-9]+\\)$"
"The regular-expression that match table item.")
(defvar irfc-reference-regex "\\[[0-9]+]"
"The regular-expression that matches normative/informative
references.")
(defvar irfc-reference-format-regex "\\[%d]"
"The format string for use with `format' function for creating
regular-expressions that match a normative/informative
reference.")
(define-derived-mode irfc-mode text-mode "Irfc"
"Major mode for IETF RFC documents."
(use-local-map irfc-mode-map)
(setq buffer-read-only t)
(setq font-lock-defaults nil)
(auto-save-mode 0)
(make-local-variable 'irfc-heading-names-list)
(make-local-variable 'irfc-heading-numbers-list)
(make-local-variable 'irfc-heading-names-table)
(make-local-variable 'irfc-heading-numbers-table)
(setq irfc-heading-names-table (make-hash-table :test 'equal))
(setq irfc-heading-numbers-table (make-hash-table :test 'equal))
(setq irfc-heading-names-list nil)
(setq irfc-heading-numbers-list nil)
(irfc-render-buffer))
(defun irfc-render-buffer ()
"Render RFC buffer."
(interactive)
(save-excursion
(let ((case-fold-search nil)
(top-point (point-min))
(title-line-point nil)
temp-point)
(irfc-overlay-remove-all)
(setq temp-point (irfc-render-buffer-hide-whitespace-at-start))
(when temp-point (setq top-point temp-point))
(setq title-line-point (irfc-render-buffer-hide-blank-line top-point))
(irfc-render-buffer-overlay-page-number)
(irfc-render-buffer-overlay-rfc-number top-point title-line-point)
(irfc-render-buffer-overlay-std-number top-point title-line-point)
(irfc-render-buffer-overlay-table-item top-point)
(irfc-render-buffer-overlay-rfc-link top-point)
(irfc-render-buffer-overlay-title title-line-point)
(irfc-render-buffer-overlay-head title-line-point)
(when irfc-highlight-requirement-keywords
(irfc-render-buffer-overlay-requirement-keyword top-point))
(when irfc-highlight-references
(irfc-render-buffer-overlay-reference top-point))
(irfc-rename-buffer title-line-point)
(irfc-fill-tables title-line-point))))
(defun irfc-render-toggle ()
"Toggle RFC buffer render status."
(interactive)
(if irfc-render-p
(irfc-render-turn-off)
(irfc-render-turn-on)))
(defun irfc-render-turn-on ()
"Turn on RFC buffer render status."
(irfc-render-buffer)
(setq irfc-render-p t))
(defun irfc-render-turn-off ()
"Turn off RFC buffer render status."
(irfc-overlay-remove-all)
(setq irfc-render-p nil))
(defun irfc-quit ()
"Quit RFC buffer."
(interactive)
(kill-buffer (current-buffer)))
(defun irfc-table-jump ()
"Jump between table and content.
You can jump to the corresponding table item when you are at content.
You can jump to the corresponding content when you are at table."
(interactive)
(if (irfc-have-table-p)
(let ((original-position (point))
head-name
page-number
match-list)
(cond ((irfc-in-table-p)
(beginning-of-line)
(if (search-forward-regexp irfc-table-regex (line-end-position) t)
(progn
(setq head-name (match-string 0))
(setq head-name (replace-regexp-in-string "[\\. ]+\\([0-9]+\\)$" "" head-name))
(setq head-name (replace-regexp-in-string "^[ ]+" "" head-name))
(setq page-number (string-to-number (match-string 3)))
(irfc-page-goto page-number)
(re-search-forward head-name nil t)
(back-to-indentation))
(message "Invalid table item.")
(goto-char original-position)))
((irfc-front-table-p)
(message "In front of table."))
(t
(end-of-line)
(setq match-list (irfc-head-move t))
(setq head-name (buffer-substring-no-properties (nth 2 match-list)
(nth 3 match-list)))
(setq page-number (irfc-current-page))
(irfc-page-table)
(re-search-forward (concat (regexp-quote head-name) "[\\. ]+"
(regexp-quote (number-to-string page-number))))
(back-to-indentation))))
(message "This RFC document contains no Table of Contents.")))
(defun irfc-reference-goto (&optional number)
"Goto reference NUMBER."
(interactive (list (irfc-read-reference)))
(let ((original-position (point)) (done nil) (found nil) (beg) (end))
(goto-char (point-min))
(while (not done)
(if (not (re-search-forward
(concat "^[ \t]*"
(format irfc-reference-format-regex number))
(point-max) t))
(setq done t)
(setq beg (match-beginning 0))
(setq end (match-end 0))
(let ((name (irfc-current-head)))
(if (not (or (string= name "References")
(string= name "Normative References")
(string= name "Informative References")))
(goto-char end)
(goto-char beg)
(setq found t)
(setq done t)))))
(when (not found)
(goto-char original-position)
(message "Cannot find reference %d" number))))
(defun irfc-read-reference ()
"Read reference as a number using a reference found at point as
default."
(let ((default (irfc-reference-at-point)))
(if (eq default nil)
(read-number "Reference number: ")
(read-number "Reference number: " default))))
(defun irfc-reference-at-point ()
"Returns reference at point as a number or nil if one is not
found."
(if (not (thing-at-point-looking-at irfc-reference-regex))
nil
(let* ((match (buffer-substring (match-beginning 0) (match-end 0)))
(len (length match)))
(string-to-number (substring match 1 (1- len))))))
(defun irfc-read-heading-name ()
"Read heading name as a string."
(completing-read "Heading name: " irfc-heading-names-list nil t))
(defun irfc-read-heading-number ()
"Read heading number as a string using a heading number found
at point as default."
(let ((default (irfc-heading-number-at-point)))
(completing-read
(concat "Heading number" (if (eq default nil) "" (format " (default %s)" default)) ": ")
irfc-heading-numbers-list nil t nil nil default nil)))
(defun irfc-heading-number-at-point ()
"Returns heading number at point as a string or nil if one is
not found."
(if (not (thing-at-point-looking-at "\\([0-9]+\\.\\)*[0-9]+"))
nil
(let ((match (match-string 0)))
(cond ((member match irfc-heading-numbers-list) match)
((member (concat match ".") irfc-heading-numbers-list) (concat match "."))))))
(defun irfc-page-goto (number)
"Goto page NUMBER."
(interactive "nPage number: ")
(cond ((<= number 1)
(call-interactively 'beginning-of-buffer)
(when (< number 1)
(message "Top page reached.")))
(t
(let ((original-position (point))
(original-render-status irfc-render-p)
reach-bottom-p)
(when (> number irfc-total-pages)
(setq number irfc-total-pages)
(setq reach-bottom-p t))
(irfc-render-turn-off)
(goto-char (point-min))
(if (re-search-forward (concat "\\[Page "
(regexp-quote (number-to-string (1- number)))
"\\]$")
nil t)
(progn
(forward-line +3)
(re-search-forward "^.+$" nil t)
(back-to-indentation)
(when reach-bottom-p
(recenter 0)
(message "Bottom page reached.")))
(goto-char original-position))
(unless (equal original-render-status irfc-render-p)
(irfc-render-toggle))))))
(defun irfc-page-next (arg)
"Move to next ARGth page.
ARG defaults to 1."
(interactive "P")
(irfc-page-goto (+ (irfc-current-page) (or arg 1))))
(defun irfc-page-prev (arg)
"Move to previous ARGth page.
ARG defaults to 1."
(interactive "P")
(irfc-page-goto (- (irfc-current-page) (or arg 1))))
(defun irfc-page-first ()
"Move to first page."
(interactive)
(irfc-page-goto 1))
(defun irfc-page-last ()
"Move to last page."
(interactive)
(irfc-page-goto irfc-total-pages))
(defun irfc-page-table ()
"Move to Table of Contents."
(interactive)
(if (irfc-have-table-p)
(progn
(goto-char (point-min))
(re-search-forward "^Table of Contents$" nil t)
(back-to-indentation))
(message "This RFC document has no Table of Contents.")))
(defun irfc-follow ()
"Open RFC document around point.
Download and open RFC document if it
does not exist in `irfc-directory'."
(interactive)
(let ((rfc-file-name (irfc-get-rfc-filename)))
(if rfc-file-name
(irfc-open rfc-file-name)
(message "No valid RFC link found at cursor."))))
(defun irfc-visit (&optional rfc-number)
"Open RFC document RFC-NUMBER.
Download and open RFC document if it
does not exist in `irfc-directory'."
(interactive)
(or rfc-number
(setq rfc-number (read-number
"RFC document to visit: "
irfc-last-visit-number)))
(setq irfc-last-visit-number rfc-number)
(irfc-open (format "rfc%s.txt" rfc-number)))
(defun irfc-head-goto (NAME)
"Goto heading NAME."
(interactive (list (irfc-read-heading-name)))
(let ((new-point (gethash NAME irfc-heading-names-table)))
(if (eq new-point nil)
(message "Cannot find heading \"%s\"" NAME)
(goto-char new-point)
(back-to-indentation))))
(defun irfc-head-next ()
"Move to next heading."
(interactive)
(let ((original-position (point)))
(end-of-line)
(if (irfc-head-move)
(beginning-of-line)
(goto-char original-position)
(message "No next heading."))))
(defun irfc-head-prev ()
"Move to previous heading."
(interactive)
(let ((original-position (point)))
(beginning-of-line)
(unless (irfc-head-move t)
(goto-char original-position)
(message "No previous heading."))))
(defun irfc-current-head (&optional print)
"Returns name of the current heading.
If optional argument PRINT is non-nil, print the name before returning it."
(interactive)
(save-excursion
(irfc-head-prev)
(re-search-forward "^\\([0-9]+\\.\?\\)+[ \t]+" (line-end-position) t)
(let ((name (buffer-substring (point) (line-end-position))))
(when print
(message "%s" name))
name)))
(defun irfc-head-number-goto (NAME)
"Goto heading number NAME."
(interactive (list (irfc-read-heading-number)))
(let ((new-point (gethash NAME irfc-heading-numbers-table)))
(if (eq new-point nil)
(irfc-head-number-goto (concat NAME "."))
(goto-char new-point)
(back-to-indentation))))
(defun irfc-scroll-up-one-line ()
"Scroll up one line."
(interactive)
(scroll-up 1))
(defun irfc-scroll-down-one-line ()
"Scroll down one line."
(interactive)
(scroll-down 1))
(defun irfc-rfc-link-next ()
"Move the point to the next RFC link."
(interactive)
(let ((original-point (point)))
(when (re-search-forward "\\(\\B\\[RFC-?[0-9]+\\]\\B\\|[ \t]+[0-9]+\\)" nil t)
(catch 'match
(while (and (not (string-match "\\[\\(RFC-?[0-9]+\\)\\]" (irfc-get-symbol-non-blank)))
(or (not (irfc-title-rfc-link-p))
(eolp)))
(unless (re-search-forward "\\(\\B\\[RFC-?[0-9]+\\]\\B\\|[ \t]+[0-9]+\\)" nil t)
(goto-char original-point)
(message "No next RFC link.")
(throw 'match "Match last one.")))))))
(defun irfc-rfc-link-prev ()
"Move the point to the previous RFC link."
(interactive)
(when (re-search-backward "\\(\\B\\[RFC-?[0-9]+\\]\\B\\|[ \t]+[0-9]+\\)" nil t)
(catch 'match
(while
(not (string-match "\\[\\(RFC-?[0-9]+\\)\\]" (irfc-get-symbol-non-blank)))
(skip-chars-forward " ")
(if (and (irfc-title-rfc-link-p)
(save-excursion
(search-forward-regexp "[0-9]+" nil t)
(not (eolp))))
(progn
(when (string-match "^request for comments:[ \t]+$"
(buffer-substring-no-properties (line-beginning-position)
(point)))
(message "No previous RFC link."))
(throw 'match "Match title RFC link."))
(re-search-backward "\\(\\B\\[RFC-?[0-9]+\\]\\B\\|[ \t]+[0-9]+\\)" nil t))))))
(defun irfc-open (rfc-file-name)
"Open RFC document with RFC-FILE-NAME."
(unless (file-directory-p irfc-directory)
(if (y-or-n-p (format "Create directory %s to hold RFCs? "
irfc-directory))
(make-directory irfc-directory t)
(error "Customize `irfc-directory', then!")))
(let (filepath)
(if (string-equal rfc-file-name (buffer-name))
(message "Current RFC document.")
(setq filepath (expand-file-name rfc-file-name irfc-directory))
(cond ((file-exists-p filepath)
(if (get-buffer rfc-file-name)
(switch-to-buffer rfc-file-name)
(find-file filepath)))
(t
(irfc-download (concat irfc-download-base-url rfc-file-name)))))))
(defun irfc-render-buffer-hide-whitespace-at-start ()
"Hide whitespace at start of file.
Return adjusted point."
(goto-char (point-min))
(if (re-search-forward "\\`\\([ \t\f]*\r?\n\\)+" nil t)
(progn
(irfc-overlay-hide-region (match-beginning 0) (match-end 0))
(point))
nil))
(defun irfc-render-buffer-overlay-page-number ()
"Add overlays for page headers and footers."
(let ((headerfooter-re (concat "^[ \t]*"
"\\(\r?\n\\)"
"\\([ \t]*\r?\n\\)*"
"[^ \t\f].*\\[Page "
"\\([0-9iIvVxX]+\\)"
"\\][ ]*\r?\n?"
"\\("
"\f"
"\\([ \t]*\r?\n\\)?"
"\\("
"\\("
"RFC [0-9]+"
"\\|"
"Internet-Draft[ \t]"
"\\)"
".*\r?\n"
"\\([ \t]*\r?\n\\)*"
"\\)?"
"\\)?"
)))
(while (re-search-forward headerfooter-re nil t)
(irfc-overlay-hide-region (match-end 1) (match-end 0))
(when (match-beginning 6)
(let* ((overlay (irfc-overlay-add (match-beginning 1)
(match-end 1)
'irfc-page-number-overlay))
(page-num (1+ (string-to-number (match-string 3))))
(page-str (format "(p.%s)" (number-to-string page-num)))
(new-str (concat (make-string (max (- 79
(- (match-beginning 1)
(match-beginning 0))
(length page-str))
0)
32)
page-str)))
(setq irfc-total-pages page-num)
(overlay-put overlay
'before-string
new-str))))))
(defun irfc-render-buffer-hide-blank-line (top-point)
"Hide any extraneous blank lines between top header and before title.
Argument TOP-POINT is the top point of RFC buffer after render."
(goto-char top-point)
(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"))
(when (match-beginning 1)
(irfc-overlay-hide-region (match-beginning 1) (match-end 1)))
(point))
(defun irfc-render-buffer-overlay-rfc-number (top-point title-line-point)
"Overlay RFC number.
Argument TOP-POINT is the top point of RFC buffer after render.
Argument TITLE-LINE-POINT is the title line point of RFC buffer after render."
(goto-char top-point)
(while (let ((case-fold-search t))
(re-search-forward "^\\(request for comments\\|updates\\|obsoletes\\):\\( RFCs\\)?[ \t]+\\(\\([0-9X]+\\)\\(,[ \t]+[0-9]+\\)*\\)"
title-line-point t))
(irfc-overlay-add (match-beginning 3)
(match-end 3)
'irfc-rfc-number-overlay)))
(defun irfc-render-buffer-overlay-std-number (top-point title-line-point)
"Overlay STD number.
Argument TOP-POINT is the top point of RFC buffer after render.
Argument TITLE-LINE-POINT is the title line point of RFC buffer after render."
(goto-char top-point)
(when (let ((case-fold-search nil))
(re-search-forward "^STD:[ \t]+[0-9]+"
title-line-point t))
(irfc-overlay-add (match-beginning 0)
(match-end 0)
'irfc-std-number-overlay)))
(defun irfc-render-buffer-overlay-table-item (top-point)
"Overlay valid item in table for jump.
Argument TOP-POINT is the top point of RFC buffer after render."
(when (irfc-have-table-p)
(goto-char top-point)
(let* ((case-fold-search t)
(start-position (re-search-forward "^Table of Contents$" nil t))
(end-position (re-search-forward "^[0-9\\.]+" nil t)))
(goto-char start-position)
(while (re-search-forward irfc-table-regex end-position t)
(irfc-overlay-add (match-beginning 2)
(match-end 2)
'irfc-table-item-overlay)))))
(defun irfc-render-buffer-overlay-rfc-link (top-point)
"Overlay valid RFC link.
Argument TOP-POINT is the top point of RFC buffer after render."
(goto-char top-point)
(while (let ((case-fold-search nil))
(re-search-forward "\\[RFC-?[0-9]+\\]"
nil t))
(irfc-overlay-add (match-beginning 0)
(match-end 0)
'irfc-rfc-link-overlay)))
(defun irfc-render-buffer-overlay-title (title-line-point)
"Add overlays to the title line(s).
Note that we currently assume no blank lines in the title; otherwise
we have to do a perfect job of identifying the first non-title line
\(usually a section heading, which some some RFCs make difficult to
always identify).
Argument TITLE-LINE-POINT is the title line point of RFC buffer after render."
(goto-char title-line-point)
(when (re-search-forward (concat
"\\([^ \t\f\r\n].*[^ \t\f\r\n]\\)"
"\\(\r?\n[ \t]*[^ \t\f\r\n].*[^ \t\f\r\n]\\)*"))
(irfc-overlay-add (match-beginning 0)
(match-end 0)
'irfc-title-overlay)))
(defun irfc-render-buffer-overlay-head (title-line-point)
"Overlay heading.
Argument TITLE-LINE-POINT is the title line point of RFC buffer after render."
(goto-char title-line-point)
(let (match-list)
(while (setq match-list (irfc-head-move))
(when (and (nth 0 match-list) (nth 1 match-list))
(irfc-overlay-add (nth 0 match-list)
(nth 1 match-list)
'irfc-head-number-overlay))
(irfc-overlay-add (nth 2 match-list)
(nth 3 match-list)
'irfc-head-name-overlay))))
(defun irfc-render-buffer-overlay-requirement-keyword (top-point)
"Overlay RFC specification requirements.
Argument TOP-POINT is the top point of RFC buffer after render."
(goto-char top-point)
(while (let ((case-fold-search nil))
(re-search-forward (regexp-opt irfc-requirement-keywords 'words)
nil t))
(irfc-overlay-add (match-beginning 0)
(match-end 0)
'irfc-requirement-keyword-overlay)))
(defun irfc-render-buffer-overlay-reference (top-point)
"Overlay RFC references.
Argument TOP-POINT is the top point of RFC buffer after render."
(goto-char top-point)
(while (let ((case-fold-search nil))
(re-search-forward irfc-reference-regex
nil t))
(irfc-overlay-add (match-beginning 0)
(match-end 0)
'irfc-reference-overlay)))
(defun irfc-rename-buffer (title-line-point)
"Rename buffer to include RFC title.
Argument TITLE-LINE-POINT is the title line point of RFC buffer after render."
(goto-char title-line-point)
(let ((rfc-txt "")
(rfc-title ""))
(when (re-search-forward (concat
"\\([^ \t\f\r\n].*[^ \t\f\r\n]\\)"
"\\(\r?\n[ \t]*[^ \t\f\r\n].*[^ \t\f\r\n]\\)*"))
(setq rfc-title (match-string 0))
(setq rfc-title (replace-regexp-in-string "[\r\n\t\f ]+" " " rfc-title)))
(when (string-match "\\(rfc[0-9]+\.txt\\)" (buffer-name))
(setq rfc-txt (match-string 1 (buffer-name))))
(if irfc-buffer-name-includes-title
(rename-buffer (concat rfc-title " (" rfc-txt ")"))
(rename-buffer rfc-txt))))
(defun irfc-fill-tables (title-line-point)
"Fill heading names/numbers tables and lists.
Argument TITLE-LINE-POINT is the title line point of RFC buffer after render."
(clrhash irfc-heading-numbers-table)
(clrhash irfc-heading-names-table)
(setq irfc-heading-numbers-list nil)
(setq irfc-heading-names-list nil)
(goto-char title-line-point)
(let (match-list)
(while (setq match-list (irfc-head-move))
(when (and (nth 0 match-list) (nth 1 match-list))
(puthash (buffer-substring (nth 0 match-list) (nth 1 match-list))
(nth 0 match-list) irfc-heading-numbers-table))
(puthash (buffer-substring (nth 2 match-list) (nth 3 match-list))
(nth 2 match-list) irfc-heading-names-table))
(maphash (lambda (number _point)
(setq irfc-heading-numbers-list (cons number irfc-heading-numbers-list)))
irfc-heading-numbers-table)
(maphash (lambda (name _point)
(setq irfc-heading-names-list (cons name irfc-heading-names-list)))
irfc-heading-names-table)))
(defun irfc-head-move (&optional reverse)
"Move to special heading.
Return heading list for overlay.
Default is to move to next heading;
move to previous heading if REVERSE is non-nil."
(let ((case-fold-search t)
(heading-re (concat
"^"
"\\("
"\\("
"\\("
"\\([0-9]+\\.?\\|[A-Z]\\.\\)"
"\\([0-9]+\\.?\\)*"
"\\)"
"[ \t]+"
"\\([^\r\n]+\\)"
"\\)"
"\\|"
"\\("
"\\("
(mapconcat 'identity irfc-stock-section-names "\\|")
"\\)"
":?[ \t]*$"
"\\)"
"\\|"
"\\("
"appendix[ \t]+"
"\\([A-Z]\\)"
"\\(\\.\\|:\\|[ \t]+-\\)"
"[ \t]+"
"\\([^\r\n]+\\)"
"\\)"
"\\)"
)))
(if (if reverse
(re-search-backward heading-re nil t)
(re-search-forward heading-re nil t))
(let ((num-match nil)
(num-highlight-begin nil)
(num-highlight-end nil)
(name-match nil))
(cond ((match-beginning 3) (setq num-match 3
name-match 6))
((match-beginning 8) (setq num-match nil
name-match 8))
((match-beginning 9) (setq num-match 10
name-match 12)
(setq num-highlight-begin (match-beginning 9)
num-highlight-end (match-end 11)))
(t (error " should never happen")))
(list
(if num-match
(or num-highlight-begin
(match-beginning num-match))
nil)
(if num-match
(or num-highlight-end
(match-end num-match))
nil)
(match-beginning name-match)
(match-end name-match)))
nil)))
(defun irfc-overlay-put-alist (symbol alist)
"Put special overlay prop with value.
SYMBOL is overlay variable.
ALIST contain special properties for overlay."
(mapc (lambda (cell)
(put symbol (nth 0 cell) (cdr cell)))
alist))
(defun irfc-overlay-remove-all ()
"Remove all overlays from current buffer."
(mapc (lambda (lst)
(when lst
(delete-overlay lst)
))
(let ((lists (overlay-lists)))
(nconc (car lists) (cdr lists)))))
(defun irfc-overlay-add (begin end category)
"Add overlay.
BEGIN is start position to overlay.
END is end position to overlay.
CATEGORY is special overlay variable."
(or category (error "Irfc-overlay-add nil category"))
(let ((overlay (make-overlay begin end)))
(overlay-put overlay 'category category)
overlay))
(defun irfc-overlay-hide-region (start end)
"Use overlay to hide region.
START is start position to hide.
END is end position to hide."
(irfc-overlay-add start end 'irfc-hide-overlay))
(defun irfc-have-table-p ()
"Return non-nil if the RFC contain a Table of Contents."
(save-excursion
(let ((case-fold-search t))
(goto-char (point-min))
(re-search-forward "^Table of Contents$" nil t))))
(defun irfc-front-table-p ()
"Return t when point is before the Table of Contents."
(let ((case-fold-search t)
(original-position (point))
table-start-position)
(save-excursion
(goto-char (point-min))
(setq table-start-position (re-search-forward "^Table of Contents$" nil t))
(< original-position table-start-position))))
(defun irfc-in-table-p ()
"Return t when point is in the Table of Contents."
(let ((case-fold-search t)
(original-position (point))
table-start-position
table-end-position)
(save-excursion
(goto-char (point-min))
(re-search-forward "^Table of Contents$" nil t)
(beginning-of-line)
(setq table-start-position (point))
(re-search-forward "^[0-9\\.]+" nil t)
(beginning-of-line)
(forward-char -1)
(setq table-end-position (point))
(and (>= original-position table-start-position)
(<= original-position table-end-position)))))
(defun irfc-current-page ()
"Return current page number at point."
(let ((original-render-status irfc-render-p)
current-page)
(save-excursion
(irfc-render-turn-off)
(if (re-search-forward "\\[Page \\([0-9]+\\)\\]$" nil t)
(setq current-page (string-to-number (match-string 1)))
(setq current-page irfc-total-pages))
(unless (equal original-render-status irfc-render-p)
(irfc-render-toggle)))
current-page))
(defun irfc-download (url)
"Download RFC document URL.
URL is download URL that base on `irfc-download-base-url'."
(let* ((url-request-method "GET")
(url-request-extra-headers nil)
(url-mime-accept-string "*/*")
(parsed-url (url-generic-parse-url url))
download-buffer
download-buffer-name)
(setq download-buffer (irfc-get-buffer))
(setq download-buffer-name (buffer-name download-buffer))
(with-current-buffer (get-buffer download-buffer-name)
(setq irfc-download-url url)
(setq irfc-download-buffer (url-retrieve url
'irfc-download-callback
(list download-buffer-name))))))
(defun irfc-download-callback (&optional redirect download-buffer-name)
"Callback for `irfc-download'.
With `irfc-download', this downloads RFC files asynchronously.
REDIRECT is default return argument for `url-retrieve'.
DOWNLOAD-BUFFER-NAME is the buffer name for handling download content."
(if (eq (car redirect) ':error)
(with-current-buffer (get-buffer download-buffer-name)
(message "Not found %s." irfc-download-url)
(kill-buffer download-buffer-name))
(irfc-retrieve-decode download-buffer-name 'utf-8)
(with-current-buffer (get-buffer download-buffer-name)
(write-file (expand-file-name (url-file-nondirectory irfc-download-url) irfc-directory))
(switch-to-buffer (current-buffer)))))
(defun irfc-retrieve-decode (retrieve-buffer-name coding)
"Decode the retrieve buffer RETRIEVE-BUFFER-NAME with coding CODING."
(declare (special url-http-end-of-headers))
(with-current-buffer (get-buffer retrieve-buffer-name)
(insert
(with-current-buffer irfc-download-buffer
(set-buffer-multibyte t)
(goto-char (1+ url-http-end-of-headers))
(decode-coding-region
(point) (point-max)
(coding-system-change-eol-conversion coding 'dos))
(buffer-substring (point) (point-max))))
(goto-char (point-min))))
(defun irfc-get-buffer ()
"Get a buffer for temporary storage of downloaded content.
Uses `current-time' to make buffer name unique."
(let ((time-now (current-time)))
(get-buffer-create (format "*irfc<%s-%s-%s>*"
(nth 0 time-now) (nth 1 time-now) (nth 2 time-now)))))
(defun irfc-get-rfc-filename ()
"Return filename for RFC file.
Look at point and extract an RFC number: either a string `[RFCnnn]',
or a RFC number in a standard header field (`Updates:', etc.).
In that case, return `rfcnnn.txt'; otherwise return nil."
(let (case-fold-search
(symbol (irfc-get-symbol-non-blank)))
(cond ((string-match "\\[\\(RFC-?[0-9]+\\)\\]" symbol)
(format "%s.txt" (replace-regexp-in-string "-" "" (downcase (match-string 1 symbol)))))
((and (string-match "^\\([0-9]+\\),*$" symbol)
(irfc-title-rfc-link-p))
(string-match "^\\([0-9]+\\),*$" symbol)
(format "rfc%s.txt" (match-string 1 symbol)))
(t
nil))))
(defun irfc-title-rfc-link-p ()
"Return t if current point is at title RFC link.
Otherwise return nil."
(save-excursion
(let ((case-fold-search t))
(search-forward-regexp " \\|$" nil t)
(skip-chars-backward " ")
(if (string-match "^\\(request for comments\\|updates\\|obsoletes\\):\\( RFCs\\)?[ \t]+\\(\\([0-9X]+\\)\\(,[ \t]+[0-9]+\\)*\\)\\b"
(buffer-substring-no-properties (line-beginning-position) (point)))
t
nil))))
(defun irfc-get-symbol-non-blank ()
"Return symbol between `blank'."
(save-excursion
(let (start end)
(search-backward-regexp " \\|^" nil t)
(skip-chars-forward " ")
(setq start (point))
(search-forward-regexp " \\|$" nil t)
(skip-chars-backward " ")
(setq end (point))
(and start
end
(>= end start)
(buffer-substring-no-properties start end)))))
(irfc-overlay-put-alist 'irfc-title-overlay '((face . irfc-title-face)))
(irfc-overlay-put-alist 'irfc-head-name-overlay '((face . irfc-head-name-face)))
(irfc-overlay-put-alist 'irfc-head-number-overlay '((face . irfc-head-number-face)))
(irfc-overlay-put-alist 'irfc-rfc-number-overlay '((face . irfc-rfc-number-face)))
(irfc-overlay-put-alist 'irfc-std-number-overlay '((face . irfc-std-number-face)))
(irfc-overlay-put-alist 'irfc-rfc-link-overlay '((face . irfc-rfc-link-face)))
(irfc-overlay-put-alist 'irfc-table-item-overlay '((face . irfc-table-item-face)))
(irfc-overlay-put-alist 'irfc-requirement-keyword-overlay '((face . irfc-requirement-keyword-face)))
(irfc-overlay-put-alist 'irfc-reference-overlay '((face . irfc-reference-face)))
(irfc-overlay-put-alist 'irfc-hide-overlay
'((face . default)
(intangible . t)
(invisible . t)))
(defun irfc-unload-function ()
"Unload the Irfc library."
(dolist (buffer (buffer-list))
(set-buffer buffer)
(when (eq major-mode 'irfc-mode)
(irfc-render-turn-off)
(text-mode)))
nil)
(provide 'irfc)