--- /dev/null
+;;; rfc-mode.el --- RFC document browser and viewer -*- lexical-binding: t -*-
+
+;; Author: Nicolas Martyanoff <nicolasNOSPAMn16f.net>
+;; SPDX-License-Identifier: ISC
+;; URL: https://github.com/galdor/rfc-mode
+;; Package-Version: 20231013.1353
+;; Package-Revision: ab09db78d9d1
+;; Package-Requires: ((emacs "25.1"))
+
+;;; Commentary:
+
+;; This package makes it easy to browse and read RFC documents.
+
+;; It offers a Helm-based browser of the list of RFCs as well as
+;; some highlighting of hyperlinks when reading the actual RFCs.
+;; If you want to browse the list without Helm, you might prefer
+;; [rfcview](http://github.com/zeph1e/rfcview.el).
+
+;; Todo:
+;; - Use font-lock
+;; - Add hyperlinks from the `Table of Contents'
+
+;;; Code:
+
+(require 'helm nil t)
+(require 'seq)
+
+
+(declare-function helm-build-sync-source "helm-source")
+(declare-function helm-make-actions "helm-lib")
+
+;;; Configuration:
+
+(defgroup rfc-mode-group nil
+ "Tools to browse and read RFC documents."
+ :prefix "rfc-mode-"
+ :link '(url-link :tag "GitHub" "https://github.com/galdor/rfc-mode")
+ :group 'external)
+
+(defface rfc-mode-document-header-face
+ '((t :inherit font-lock-comment-face))
+ "Face used for RFC document page headers.")
+
+(defface rfc-mode-document-footer-face
+ '((t :inherit font-lock-comment-face))
+ "Face used for RFC document page footers.")
+
+(defface rfc-mode-document-section-title-face
+ '((t :inherit font-lock-keyword-face))
+ "Face used for RFC document section titles.")
+
+(defface rfc-mode-browser-ref-face
+ '((t :inherit font-lock-preprocessor-face))
+ "Face used to highlight RFC references in the RFC browser.")
+
+(defface rfc-mode-browser-title-face
+ '((t :inherit default))
+ "Face used to highlight the title of RFC documents in the RFC browser.")
+
+(defface rfc-mode-browser-title-obsolete-face
+ '((t :inherit font-lock-comment-face))
+ "Face used to highlight the title of obsolete RFC documents in the RFC browser.")
+
+(defface rfc-mode-browser-status-face
+ '((t :inherit font-lock-keyword-face))
+ "Face used to highlight RFC document statuses in the RFC browser.")
+
+(defcustom rfc-mode-directory (expand-file-name "~/rfc/")
+ "The directory where RFC documents are stored."
+ :type 'directory)
+
+(defcustom rfc-mode-document-url
+ "https://www.rfc-editor.org/rfc/rfc%s.txt"
+ "A `format'able URL for fetching arbitrary RFC documents.
+Assume RFC documents are named as e.g. rfc21.txt, rfc-index.txt."
+ :type 'string)
+
+(defcustom rfc-mode-browse-input-function
+ (if (featurep 'helm) 'helm 'completing-read)
+ "Function used by `rfc-mode-browse' to read user input.
+
+Only `read-number', `completing-read' and `helm' are explicitly
+supported. Any other function is called with no arguments and
+must return an integer.
+
+Here `completion-read' works best if you use some completion
+mode that displays candidates \"vertically\" like `helm' does.
+`ivy-mode' is a popular choice. `fido-mode' in combination
+with `icomplete-vertical-mode' should also work well."
+ :type '(choice (const read-number)
+ (const completing-read)
+ (const helm)
+ function))
+
+(defcustom rfc-mode-use-original-buffer-names nil
+ "Whether RFC document buffers should have the name of the document file.
+If nil (the default) then use e.g. *rfc21*, otherwise use e.g. rfc21.txt."
+ :type 'boolean)
+
+(defcustom rfc-mode-browser-entry-title-width 60
+ "The width of the column containing RFC titles in the browser."
+ :type 'integer)
+
+(defcustom rfc-mode-imenu-title "RFC Contents"
+ "The title to use if `rfc-mode' adds a RFC Contents menu to the menubar."
+ :type 'string)
+
+;;; Misc variables:
+
+(defvar rfc-mode-index-entries nil
+ "The list of entries in the RFC index.")
+
+(defconst rfc-mode-title-regexp "^\\(?:[0-9]+\\.\\)+\\(?:[0-9]+\\)? .*$"
+ "Regular expression to model section titles in RFC documents.")
+
+(defvar-local rfc-mode--titles nil
+ "Buffer-local variable that keeps a list of section titles in this RFC.")
+
+(defvar rfc-mode--last-title nil
+ "Last section title that the user visited.")
+
+;;; Keys:
+
+(defvar rfc-mode-map
+ (let ((map (make-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map (kbd "<tab>") #'forward-button)
+ (define-key map (kbd "<backtab>") #'backward-button)
+ (define-key map (kbd "<prior>") #'rfc-mode-backward-page)
+ (define-key map (kbd "<next>") #'rfc-mode-forward-page)
+ (define-key map (kbd "g") #'rfc-mode-goto-section)
+ (define-key map (kbd "n") #'rfc-mode-next-section)
+ (define-key map (kbd "p") #'rfc-mode-previous-section)
+ map)
+ "The keymap for `rfc-mode'.")
+
+;;; Main:
+
+(defun rfc-mode-init ()
+ "Initialize the current buffer for `rfc-mode'."
+ (setq-local page-delimiter "^.*?\n\f")
+ (rfc-mode-highlight)
+ (setq imenu-generic-expression (list (list nil rfc-mode-title-regexp 0)))
+ (imenu-add-to-menubar rfc-mode-imenu-title))
+
+(define-obsolete-function-alias 'rfc-mode-quit #'quit-window "rfc-mode-1.4")
+
+(defun rfc-mode-recenter ()
+ "Do the same as `recenter-top-bottom' would for the `top' position."
+ (rfc-mode-header-start)
+ (let ((recenter-positions '(top)))
+ (recenter-top-bottom)))
+
+(defun rfc-mode-backward-page ()
+ "Scroll to the previous page of the current buffer."
+ (interactive)
+ (beginning-of-line)
+ (unless (looking-at "\f")
+ (backward-page))
+ (backward-page)
+ (beginning-of-line 1)
+ (rfc-mode-recenter))
+
+(defun rfc-mode-forward-page ()
+ "Scroll to the next page of the current buffer."
+ (interactive)
+ (forward-page)
+ (beginning-of-line 1)
+ (rfc-mode-recenter))
+
+(defun rfc-mode-goto-section (section) ;FIXME: Why not use imenu for that?
+ "Move point to SECTION."
+ (interactive
+ (let* ((default (if (member rfc-mode--last-title rfc-mode--titles)
+ rfc-mode--last-title
+ (car rfc-mode--titles)))
+ (completion-ignore-case t)
+ (prompt (concat "Go to section (default " default "): "))
+ (chosen (completing-read prompt rfc-mode--titles
+ nil nil nil nil default)))
+ (list chosen)))
+ (setq rfc-mode--last-title section)
+ (unless (rfc-mode--goto-section section)
+ (error "Section %s not found" section)))
+
+(defun rfc-mode--goto-section (section)
+ "Move point to SECTION if it exists, otherwise don't move point.
+Returns t if section is found, nil otherwise."
+ (let ((curpos (point))
+ (case-fold-search nil))
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^" section) (point-max) t)
+ (progn
+ (beginning-of-line)
+ (rfc-mode-recenter)
+ t)
+ (goto-char curpos)
+ nil)))
+
+(defun rfc-mode-next-section (n)
+ "Move point to Nth next section (default 1)."
+ (interactive "p")
+ (let ((case-fold-search nil)
+ (start (point)))
+ (if (looking-at rfc-mode-title-regexp)
+ (forward-line 1))
+ (if (re-search-forward rfc-mode-title-regexp (point-max) t n)
+ (progn
+ (beginning-of-line)
+ (rfc-mode-recenter))
+ (goto-char (point-max))
+ ;; The last line doesn't belong to any section.
+ (forward-line -1))
+ ;; Ensure we never move back from the starting point.
+ (if (< (point) start) (goto-char start))))
+
+(defun rfc-mode-previous-section (n)
+ "Move point to Nth previous section (default 1)."
+ (interactive "p")
+ (let ((case-fold-search nil))
+ (if (looking-at rfc-mode-title-regexp)
+ (forward-line -1))
+ (if (re-search-backward rfc-mode-title-regexp (point-min) t n)
+ (progn
+ (beginning-of-line)
+ (rfc-mode-recenter))
+ (goto-char (point-min)))))
+
+;;;###autoload
+(defun rfc-mode-read (number)
+ "Read the RFC document NUMBER.
+Offer the number at point as default."
+ (interactive
+ (if (and current-prefix-arg (not (consp current-prefix-arg)))
+ (list (prefix-numeric-value current-prefix-arg))
+ (list (read-number "RFC number: " (rfc-mode--integer-at-point)))))
+ (display-buffer (rfc-mode--document-buffer number)))
+
+(defun rfc-mode-reload-index ()
+ "Reload the RFC document index from its original file."
+ (interactive)
+ (setq rfc-mode-index-entries nil))
+
+(defun rfc-mode--index-entries ()
+ (or rfc-mode-index-entries
+ (let ((file (rfc-mode--document-file "-index")))
+ (setq rfc-mode-index-entries
+ (rfc-mode-read-index-file file)))))
+
+;;;###autoload
+(defun rfc-mode-browse ()
+ "Browse through all RFC documents referenced in the index."
+ (interactive)
+ (pcase rfc-mode-browse-input-function
+ ('read-number
+ (display-buffer (rfc-mode--document-buffer
+ (read-number "View RFC document: "
+ (rfc-mode--integer-at-point)))))
+ ('helm
+ (if (fboundp 'helm)
+ (helm :buffer "*helm rfc browser*"
+ :sources (rfc-mode-browser-helm-sources
+ (rfc-mode--index-entries)))
+ (user-error "Helm has to be installed explicitly")))
+ ('completing-read
+ (let* ((default (rfc-mode--integer-at-point))
+ (cands (mapcar (lambda (entry)
+ (let ((cand
+ (rfc-mode-browser-format-candidate entry)))
+ (and (numberp default)
+ (= (plist-get entry :number) default)
+ (setq default (car cand)))
+ cand))
+ (rfc-mode--index-entries)))
+ (choice (completing-read "View RFC document: "
+ cands nil nil nil nil default))
+ (number (or (and (string-match "\\`RFC\\([0-9]+\\)" choice)
+ (string-to-number (match-string 1 choice)))
+ (ignore-errors (string-to-number choice)))))
+ (unless number
+ (user-error
+ "%s doesn't match a completion candidate and is not a number"
+ choice))
+ (display-buffer (rfc-mode--document-buffer number))))
+ (_ (display-buffer (rfc-mode--document-buffer
+ (funcall rfc-mode-browse-input-function))))))
+
+;;;###autoload
+(define-derived-mode rfc-mode special-mode "rfc-mode"
+ "Major mode to browse and read RFC documents."
+ (rfc-mode-init))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("/rfc[0-9]+\\.txt\\'" . rfc-mode))
+(add-to-list 'auto-mode-alist '("\\*rfc[0-9]+\\*\\'" . rfc-mode))
+
+;;; Syntax utils:
+
+(defun rfc-mode-highlight ()
+ "Highlight the current buffer."
+ (setq rfc-mode--titles nil)
+ ;; FIXME: Use font-lock!
+ (with-silent-modifications
+ (let ((inhibit-read-only t))
+ ;; Headers and footers
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward "\f" nil t)
+ (beginning-of-line)
+ (let ((form-feed (point)))
+ (let* ((footer-end (rfc-mode-previous-footer-start))
+ (footer-start (point)))
+ (put-text-property
+ footer-start footer-end
+ 'face 'rfc-mode-document-footer-face))
+ (goto-char form-feed)
+ (let* ((header-end (rfc-mode-header-start))
+ (header-start (point)))
+ (put-text-property
+ header-start header-end
+ 'face 'rfc-mode-document-header-face)
+ (goto-char header-end)))))
+ ;; Section titles
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward-regexp rfc-mode-title-regexp nil t)
+ (let ((start (match-beginning 0))
+ (end (match-end 0)))
+ (put-text-property start end
+ 'face 'rfc-mode-document-section-title-face)
+ (push (match-string 0) rfc-mode--titles)
+ (goto-char end))))
+ ;; Keep titles in expected top to bottom order.
+ (setq rfc-mode--titles (nreverse rfc-mode--titles))
+ ;; RFC references
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward-regexp "RFC *\\([0-9]+\\)" nil t)
+ (let ((start (match-beginning 0))
+ (end (match-end 0))
+ (number (string-to-number (match-string 1))))
+ (unless (= start (line-beginning-position))
+ (make-text-button start end
+ 'action (lambda (_button)
+ (rfc-mode-read number))
+ 'help-echo (format "Read RFC %d" number)
+ 'follow-link t))
+ (goto-char end)))))))
+
+(defun rfc-mode-header-start ()
+ "Move to the start of the current header.
+
+When the point is on a form feed character, move it to the start
+of the current page header and return the position of the end of
+the header."
+ (when (looking-at "\f")
+ (forward-line 1)
+ (move-end-of-line 1)
+ (prog1 (point)
+ (move-beginning-of-line 1))))
+
+(defun rfc-mode-previous-footer-start ()
+ "Move to the start of the previous footer.
+
+When the point is on a form feed character, move it to the start
+of the previous page footer and return the position of the end of
+the footer."
+ (when (looking-at "\f")
+ (forward-line -1)
+ (move-end-of-line 1)
+ (prog1 (point)
+ (move-beginning-of-line 1))))
+
+;;; Browser utils:
+
+(defun rfc-mode-browser-helm-sources (entries)
+ "Create a Helm source for ENTRIES.
+
+ENTRIES is a list of RFC index entries in the browser."
+ (helm-build-sync-source "RFC documents"
+ :candidates (mapcar #'rfc-mode-browser-format-candidate entries)
+ :action (helm-make-actions
+ "Read" #'rfc-mode-browser-helm-entry-read)))
+
+(defun rfc-mode-browser-format-candidate (entry)
+ "Create a Helm candidate for ENTRY.
+
+ENTRY is a RFC index entry in the browser."
+ (let* ((ref (rfc-mode--pad-string
+ (format "RFC%d" (plist-get entry :number)) 7))
+ (title (rfc-mode--pad-string
+ (plist-get entry :title)
+ rfc-mode-browser-entry-title-width))
+ (status (or (plist-get entry :status) ""))
+ (obsoleted-by (plist-get entry :obsoleted-by))
+ (obsoletep (> (length obsoleted-by) 0))
+ (string (format "%s %s %s"
+ (rfc-mode--highlight-string
+ ref 'rfc-mode-browser-ref-face)
+ (rfc-mode--highlight-string
+ title (if obsoletep
+ 'rfc-mode-browser-title-obsolete-face
+ 'rfc-mode-browser-title-face))
+ (rfc-mode--highlight-string
+ status 'rfc-mode-browser-status-face))))
+ (cons string entry)))
+
+(defun rfc-mode-browser-helm-entry-read (entry)
+ "The read action the Helm candidate ENTRY in the browser."
+ (let ((number (plist-get entry :number)))
+ (rfc-mode-read number)))
+
+;;; Index utils:
+
+(defun rfc-mode-read-index-file (filename)
+ "Read an RFC index file at FILENAME and return a list of entries."
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (rfc-mode-read-index (current-buffer))))
+
+(defun rfc-mode-read-index (buffer)
+ "Read an RFC index file from BUFFER and return a list of entries."
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (let ((entries nil))
+ (while (search-forward-regexp "^[0-9]+ " nil t)
+ (let ((start (match-beginning 0)))
+ (search-forward-regexp " $")
+ (let* ((end (match-beginning 0))
+ (lines (buffer-substring start end))
+ (entry-string (replace-regexp-in-string "[ \n]+" " " lines))
+ (entry (rfc-mode-parse-index-entry entry-string)))
+ (unless (string= (plist-get entry :title) "Not Issued")
+ (push entry entries)))))
+ (nreverse entries))))
+
+(defun rfc-mode-parse-index-entry (string)
+ "Parse the RFC document index entry STRING and return it as a plist."
+ (unless (string-match "\\(^[0-9]+\\) *\\(.*?\\)\\.\\(?: \\|$\\)" string)
+ (error "Invalid index entry format: %S" string))
+ (let* ((number-string (match-string 1 string))
+ (number (string-to-number number-string))
+ (title (match-string 2 string)))
+ (when (zerop number)
+ (error "Invalid index entry number: %S" number-string))
+ (let ((entry (list :number number :title title)))
+ (when (string-match "(Status: \\([^)]+\\))" string)
+ (plist-put entry :status (downcase (match-string 1 string))))
+ (when (string-match "(Obsoletes \\([^)]+\\))" string)
+ (plist-put entry :obsoletes
+ (rfc-mode--parse-rfc-refs (match-string 1 string))))
+ (when (string-match "(Obsoleted by \\([^)]+\\))" string)
+ (plist-put entry :obsoleted-by
+ (rfc-mode--parse-rfc-refs (match-string 1 string))))
+ (when (string-match "(Updates \\([^)]+\\))" string)
+ (plist-put entry :updates
+ (rfc-mode--parse-rfc-refs (match-string 1 string))))
+ (when (string-match "(Updated by \\([^)]+\\))" string)
+ (plist-put entry :updated-by
+ (rfc-mode--parse-rfc-refs (match-string 1 string))))
+ entry)))
+
+;;; Document utils:
+
+(defun rfc-mode--document-buffer-name (number)
+ "Return the buffer name for the RFC document NUMBER."
+ (concat "*rfc" (number-to-string number) "*"))
+
+(defun rfc-mode--document-file (number)
+ "Return the absolute file name of the RFC document NUMBER."
+ (let ((file
+ (expand-file-name (format "rfc%s.txt" number) rfc-mode-directory)))
+ (rfc-mode--ensure-directory-exists)
+ (unless (file-exists-p file)
+ (url-copy-file (format rfc-mode-document-url number) file))
+ file))
+
+(defun rfc-mode--document-buffer (number)
+ "Return a buffer visiting the RFC document NUMBER.
+
+The buffer is created if it does not exist."
+ (let* ((buffer-name (rfc-mode--document-buffer-name number))
+ (document-path (rfc-mode--document-file number)))
+ (with-current-buffer (find-file-noselect document-path)
+ (unless rfc-mode-use-original-buffer-names
+ (rename-buffer buffer-name))
+ (rfc-mode)
+ (current-buffer))))
+
+;;; Misc utils:
+
+(defun rfc-mode--integer-at-point ()
+ ;; Note that we don't use `number-at-point' as it will match
+ ;; number formats that make no sense as RFC numbers (floating
+ ;; point, hexadecimal, etc.).
+ (save-excursion
+ (skip-chars-backward "0-9")
+ (and (looking-at "[0-9]")
+ (string-to-number
+ (buffer-substring-no-properties
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point)))))))
+
+(defun rfc-mode--ensure-directory-exists ()
+ "Check that `rfc-mode-directory' exists, creating it if it does not."
+ (when (and (not (file-exists-p rfc-mode-directory))
+ (y-or-n-p (format "Create directory %s? " rfc-mode-directory)))
+ (make-directory rfc-mode-directory t)))
+
+(defun rfc-mode--parse-rfc-ref (string)
+ "Parse a reference to a RFC document from STRING.
+
+For example: \"RFC 2822\"."
+ (when (string-match "^RFC *\\([0-9]+\\)" string)
+ (string-to-number (match-string 1 string))))
+
+(defun rfc-mode--parse-rfc-refs (string)
+ "Parse a list of references to RFC documents from STRING.
+
+For example: \"RFC3401, RFC3402 ,RFC 3403\"."
+ (seq-remove #'null (mapcar #'rfc-mode--parse-rfc-ref
+ (split-string string "," t " +"))))
+
+(defun rfc-mode--pad-string (string width)
+ "Pad STRING with spaces to WIDTH characters."
+ (truncate-string-to-width string width 0 ?\s))
+
+(defun rfc-mode--highlight-string (string face)
+ "Highlight STRING using FACE."
+ (put-text-property 0 (length string) 'face face string)
+ string)
+
+(provide 'rfc-mode)
+
+;;; rfc-mode.el ends here
projects / emacsconfig.git / commitdiff