Cleanup 'thing-at-point' integration
[elpher.git] / elpher.el
index b323cbb..662e451 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -1,13 +1,28 @@
-;;; elpher.el --- A friendly gopher and gemini client  -*- lexical-binding:t -*-
-
-;; Copyright (C) 2019-2020 Tim Vaughan
+;;; elpher.el --- A friendly gopher and gemini client  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Jens Östlund <jostlund@gmail.com>
+;; Copyright (C) 2021 F. Jason Park <jp@neverwas.me>
+;; Copyright (C) 2021 Christopher Brannon <chris@the-brannons.com>
+;; Copyright (C) 2021 Omar Polo <op@omarpolo.com>
+;; Copyright (C) 2021 Noodles! <nnoodle@chiru.no>
+;; Copyright (C) 2020-2021 Alex Schroeder <alex@gnu.org>
+;; Copyright (C) 2020 Zhiwei Chen <chenzhiwei03@kuaishou.com>
+;; Copyright (C) 2020 condy0919 <condy0919@gmail.com>
+;; Copyright (C) 2020 Alexis <flexibeast@gmail.com>
+;; Copyright (C) 2020 Étienne Deparis <etienne@depar.is>
+;; Copyright (C) 2020 Simon Nicolussi <sinic@sinic.name>
+;; Copyright (C) 2020 Michel Alexandre Salim <michel@michel-slm.name>
+;; Copyright (C) 2020 Koushk Roy <kroy@twilio.com>
+;; Copyright (C) 2020 Vee <vee@vnsf.xyz>
+;; Copyright (C) 2020 Simon South <simon@simonsouth.net>
+;; Copyright (C) 2019-2020 Tim Vaughan <plugd@thelambdalab.xyz>
 
 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
-;; Version: 2.10.2
+;; Version: 2.11.0
 ;; Keywords: comm gopher
-;; Homepage: http://thelambdalab.xyz/elpher
-;; Package-Requires: ((emacs "26.2"))
+;; Homepage: https://alexschroeder.ch/cgit/elpher
+;; Package-Requires: ((emacs "27.1"))
 
 ;; This file is not part of GNU Emacs.
 
@@ -48,7 +63,7 @@
 
 ;; Elpher is under active development.  Any suggestions for
 ;; improvements are welcome, and can be made on the official
-;; project page, gopher://thelambdalab.xyz/1/projects/elpher/.
+;; project page, https://alexschroeder.ch/cgit/elpher.
 
 ;;; Code:
 
 (require 'url-util)
 (require 'subr-x)
 (require 'dns)
-(require 'ansi-color)
 (require 'nsm)
 (require 'gnutls)
 (require 'socks)
-
+(require 'ol)
+
+;;; ANSI colors or XTerm colors
+
+(or (require 'xterm-color nil t)
+    (require 'ansi-color))
+
+(defalias 'elpher-color-filter-apply
+  (if (fboundp 'xterm-color-filter)
+      (lambda (s)
+       (let ((xterm-color-render nil))
+         (xterm-color-filter s)))
+    'ansi-color-filter-apply)
+  "A function to filter out ANSI escape sequences.")
+(defalias 'elpher-color-apply
+  (if (fboundp 'xterm-color-filter)
+      'xterm-color-filter
+    'ansi-color-apply)
+  "A function to apply ANSI escape sequences.")
 
 ;;; Global constants
 ;;
 
-(defconst elpher-version "2.10.2"
+(defconst elpher-version "2.11.0"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
   "Association list from types to getters, renderers, margin codes and index faces.")
 
 
+;;; Internal variables
+;;
+
+;; buffer-local
+(defvar elpher--gemini-page-headings nil
+  "List of headings on the page.")
+
+(defvar elpher--gemini-page-links nil
+  "List of links on the page.")
+
+(defvar elpher--gemini-page-links-cache (make-hash-table :test 'equal)
+  "Hash of addresses and page links.")
+
 ;;; Customization group
 ;;
 
@@ -121,8 +166,9 @@ Otherwise, use the system browser via the BROWSE-URL function."
 
 (defcustom elpher-auto-disengage-TLS nil
   "If non-nil, automatically disengage TLS following an unsuccessful connection.
-While enabling this may seem convenient, it is also potentially dangerous as it
-allows switching from an encrypted channel back to plain text without user input."
+While enabling this may seem convenient, it is also potentially
+dangerous as it allows switching from an encrypted channel back to
+plain text without user input."
   :type '(boolean))
 
 (defcustom elpher-connection-timeout 5
@@ -145,6 +191,11 @@ These certificates may be used for establishing authenticated TLS connections."
   "The command used to launch openssl when generating TLS client certificates."
   :type '(file))
 
+(defcustom elpher-default-url-type "gopher"
+  "Default URL type (i.e. scheme) to assume if not explicitly given."
+  :type '(choice (const "gopher")
+                 (const "gemini")))
+
 (defcustom elpher-gemini-TLS-cert-checks nil
   "If non-nil, verify gemini server TLS certs using the default security level.
 Otherwise, certificate verification is disabled.
@@ -184,6 +235,11 @@ some servers which do not support IPv6 can take a long time to time-out."
 Otherwise, the SOCKS proxy is only used for connections to onion services."
   :type '(boolean))
 
+(defcustom elpher-gemini-number-links nil
+  "If non-nil, number links in gemini pages when rendering.
+Links can be accessed by pressing `v' ('visit') followed by the link number."
+  :type '(boolean))
+
 ;; Face customizations
 
 (defgroup elpher-faces nil
@@ -282,13 +338,17 @@ Otherwise, the SOCKS proxy is only used for connections to onion services."
             (setf (url-filename url)
                   (url-unhex-string (url-filename url)))
             (unless (url-type url)
-              (setf (url-type url) "gopher"))
+              (setf (url-type url) elpher-default-url-type))
+            (unless (url-host url)
+              (let ((p (split-string (url-filename url) "/" nil nil)))
+                (setf (url-host url) (car p))
+                (setf (url-filename url)
+                      (if (cdr p)
+                          (concat "/" (mapconcat #'identity (cdr p) "/"))
+                        ""))))
             (when (or (equal "gopher" (url-type url))
                       (equal "gophers" (url-type url)))
               ;; Gopher defaults
-              (unless (url-host url)
-                (setf (url-host url) (url-filename url))
-                (setf (url-filename url) ""))
               (when (or (equal (url-filename url) "")
                         (equal (url-filename url) "/"))
                 (setf (url-filename url) "/1")))
@@ -467,12 +527,17 @@ unless NO-HISTORY is non-nil."
   (setq-local elpher-current-page page)
   (let* ((address (elpher-page-address page))
          (type (elpher-address-type address))
-         (type-record (cdr (assoc type elpher-type-map))))
+         (type-record (cdr (assoc type elpher-type-map)))
+         (page-links nil))
     (if type-record
-        (funcall (car type-record)
-                 (if renderer
-                     renderer
-                   (cadr type-record)))
+        (progn
+          (funcall (car type-record)
+                   (if renderer
+                       renderer
+                     (cadr type-record)))
+          (setq page-links (gethash address elpher--gemini-page-links-cache))
+          (if page-links
+              (setq elpher--gemini-page-links page-links)))
       (elpher-visit-previous-page)
       (pcase type
         (`(gopher ,type-char)
@@ -573,7 +638,7 @@ If LINE is non-nil, replace that line instead."
   "Preprocess text selector response contained in STRING.
 This involes decoding the character representation, and clearing
 away CRs and any terminating period."
-  (elpher-decode (replace-regexp-in-string "\n\.\n$" "\n"
+  (elpher-decode (replace-regexp-in-string "\n\\.\n$" "\n"
                                            (replace-regexp-in-string "\r" "" string))))
 
 
@@ -631,7 +696,8 @@ the host operating system and the local network capabilities."
     (unless (< (elpher-address-port address) 65536)
       (error "Cannot establish network connection: port number > 65536"))
     (when (and (eq use-tls 'gemini) (not elpher-gemini-TLS-cert-checks))
-      (setq-local network-security-level 'low))
+      (setq-local network-security-level 'low)
+      (setq-local gnutls-verify-error nil))
     (condition-case nil
         (let* ((kill-buffer-query-functions nil)
                (port (elpher-address-port address))
@@ -829,7 +895,7 @@ base for the installed key and certificate files."
   (mapcar
    (lambda (file)
      (file-name-sans-extension file))
-   (directory-files elpher-certificate-directory nil "\.key$")))
+   (directory-files elpher-certificate-directory nil "\\.key$")))
 
 (defun elpher-forget-current-certificate ()
   "Causes any current certificate to be forgotten.)
@@ -951,7 +1017,7 @@ If ADDRESS is not supplied or nil the record is rendered as an
     (if type-map-entry
         (let* ((margin-code (elt type-map-entry 2))
                (face (elt type-map-entry 3))
-               (filtered-display-string (ansi-color-filter-apply display-string))
+               (filtered-display-string (elpher-color-filter-apply display-string))
                (page (elpher-make-page filtered-display-string address)))
           (elpher-insert-margin margin-code)
           (insert-text-button filtered-display-string
@@ -989,7 +1055,7 @@ If ADDRESS is not supplied or nil the record is rendered as an
 ;; Text rendering
 
 (defconst elpher-url-regex
-  "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]*[a-zA-Z0-9\-]\\|\[[a-zA-Z0-9:]+\]\\)\\(:[0-9]+\\)?\\(/\\([0-9a-zA-Z\-_~?/@|:.%#=&]*[0-9a-zA-Z\-_~?/@|#]\\)?\\)?"
+  "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.-]*[a-zA-Z0-9-]\\|\\[[a-zA-Z0-9:]+\\]\\)\\(:[0-9]+\\)?\\(/\\([0-9a-zA-Z_~?/@|:.%#=&-]*[0-9a-zA-Z_~?/@|#-]\\)?\\)?"
   "Regexp used to locate and buttinofy URLs in text files loaded by elpher.")
 
 (defun elpher-buttonify-urls (string)
@@ -1010,14 +1076,14 @@ If ADDRESS is not supplied or nil the record is rendered as an
     (buffer-string)))
 
 (defconst elpher-ansi-regex "\x1b\\[[^m]*m"
-  "Wildly incomplete regexp used to strip out some troublesome ANSI escape sequences.")
+  "Incomplete regexp used to strip out some troublesome ANSI escape sequences.")
 
 (defun elpher-process-text-for-display (string)
   "Perform any desired processing of STRING prior to display as text.
 Currently includes buttonifying URLs and processing ANSI escape codes."
   (elpher-buttonify-urls (if elpher-filter-ansi-from-text
-                             (ansi-color-filter-apply string)
-                           (ansi-color-apply string))))
+                             (elpher-color-filter-apply string)
+                           (elpher-color-apply string))))
 
 (defun elpher-render-text (data &optional _mime-type-string)
   "Render DATA as text.  MIME-TYPE-STRING is unused."
@@ -1365,11 +1431,12 @@ treatment that a separate function is warranted."
          (address (elpher-address-from-gemini-url url))
          (type (if address (elpher-address-type address) nil))
          (type-map-entry (cdr (assoc type elpher-type-map))))
+    (setq elpher--gemini-page-links (append elpher--gemini-page-links `(,address)))
     (when display-string
       (insert elpher-gemini-link-string)
       (if type-map-entry
           (let* ((face (elt type-map-entry 3))
-                 (filtered-display-string (ansi-color-filter-apply display-string))
+                 (filtered-display-string (elpher-color-filter-apply display-string))
                  (page (elpher-make-page filtered-display-string address)))
             (insert-text-button filtered-display-string
                                 'face face
@@ -1391,7 +1458,13 @@ by HEADER-LINE."
                    (1 'elpher-gemini-heading1)
                    (2 'elpher-gemini-heading2)
                    (3 'elpher-gemini-heading3)
-                   (_ 'default))))
+                   (_ 'default)))
+          (fill-column (if (display-graphic-p)
+                           (/ (* fill-column
+                                 (font-get (font-spec :name (face-font 'default)) :size))
+                              (font-get (font-spec :name (face-font face)) :size)) fill-column)))
+      (setq elpher--gemini-page-headings (cons (cons header (point))
+                                               elpher--gemini-page-headings))
       (unless (display-graphic-p)
         (insert (make-string level ?#) " "))
       (insert (propertize header 'face face))
@@ -1400,14 +1473,14 @@ by HEADER-LINE."
 (defun elpher-gemini-insert-text (text-line)
   "Insert a plain non-preformatted TEXT-LINE into a text/gemini document.
 This function uses Emacs' auto-fill to wrap text sensibly to a maximum
-width defined by elpher-gemini-max-fill-width."
-  (string-match "\\(^[ \t]*\\)\\(\*[ \t]+\\|>[ \t]*\\)?" text-line)
+width defined by `elpher-gemini-max-fill-width'."
+  (string-match "\\(^[ \t]*\\)\\(\\*[ \t]+\\|>[ \t]*\\)?" text-line)
   (let* ((line-prefix (match-string 2 text-line))
          (processed-text-line
           (if line-prefix
               (cond ((string-prefix-p "*" line-prefix)
                      (concat
-                      (replace-regexp-in-string "\*"
+                      (replace-regexp-in-string "\\*"
                                                 elpher-gemini-bullet-string
                                                 (match-string 0 text-line))
                       (substring text-line (match-end 0))))
@@ -1422,21 +1495,38 @@ width defined by elpher-gemini-max-fill-width."
 (defun elpher-render-gemini-map (data _parameters)
   "Render DATA as a gemini map file, PARAMETERS is currently unused."
   (elpher-with-clean-buffer
-   (let ((preformatted nil))
+   (setq elpher--gemini-page-headings nil)
+   (let ((preformatted nil)
+         (link-counter 1))
      (auto-fill-mode 1)
      (setq-local fill-column (min (window-width) elpher-gemini-max-fill-width))
+     (setq elpher--gemini-page-links '())
      (dolist (line (split-string data "\n"))
        (cond
         ((string-prefix-p "```" line) (setq preformatted (not preformatted)))
         (preformatted (insert (elpher-process-text-for-display
                                (propertize line 'face 'elpher-gemini-preformatted))
                               "\n"))
-        ((string-prefix-p "=>" line) (elpher-gemini-insert-link line))
+        ((string-prefix-p "=>" line)
+         (progn
+           (if elpher-gemini-number-links
+               (insert
+                (concat
+                 "["
+                 (number-to-string link-counter)
+                 "] ")))
+           (setq link-counter (1+ link-counter))
+           (elpher-gemini-insert-link line)))
         ((string-prefix-p "#" line) (elpher-gemini-insert-header line))
         (t (elpher-gemini-insert-text line)))))
+   (setq elpher--gemini-page-headings (nreverse elpher--gemini-page-headings))
    (elpher-cache-content
     (elpher-page-address elpher-current-page)
-    (buffer-string))))
+    (buffer-string))
+   (puthash
+    (elpher-page-address elpher-current-page)
+    elpher--gemini-page-links
+    elpher--gemini-page-links-cache)))
 
 (defun elpher-render-gemini-plain-text (data _parameters)
   "Render DATA as plain text file.  PARAMETERS is currently unused."
@@ -1527,6 +1617,7 @@ The result is rendered using RENDERER."
            " - u/mouse-3/U: return to previous page or to the start page\n"
            " - o/O: visit different selector or the root menu of the current server\n"
            " - g: go to a particular address (gopher, gemini, finger)\n"
+           " - v: visit a numbered link on a gemini page\n"
            " - d/D: download item under cursor or current page\n"
            " - i/I: info on item under cursor or current page\n"
            " - c/C: copy URL representation of item under cursor or current page\n"
@@ -1549,8 +1640,8 @@ The result is rendered using RENDERER."
            "Alternatively, select a search engine and enter some search terms:\n")
    (elpher-insert-index-record "Gopher Search Engine (Veronica-2)"
                                (elpher-make-gopher-address ?7 "/v2/vs" "gopher.floodgap.com" 70))
-   (elpher-insert-index-record "Gemini Search Engine (GUS)"
-                               (elpher-address-from-url "gemini://gus.guru/search"))
+   (elpher-insert-index-record "Gemini Search Engine (geminispace.info)"
+                               (elpher-address-from-url "gemini://geminispace.info/search"))
    (insert "\n"
            "This page contains your bookmarked sites (also visit with B):\n")
    (elpher-insert-index-record "Your Bookmarks" 'bookmarks)
@@ -1686,6 +1777,52 @@ If ADDRESS is already bookmarked, update the label only."
                    (not (equal (elpher-bookmark-url bookmark) url)))
                  (elpher-load-bookmarks)))))
 
+;;; Integrations
+;;
+
+;; Avoid byte compilation warnings.
+(eval-when-compile
+  (declare-function org-link-store-props "ol")
+  (declare-function org-link-set-parameters "ol")
+  (defvar thing-at-point-uri-schemes))
+
+(defun elpher-org-link-store ()
+  "Store link to an `elpher' page in `org'."
+  (when (eq major-mode 'elpher-mode)
+    (let ((link (concat "elpher:" (elpher-info-current)))
+          (desc (car elpher-current-page)))
+      (org-link-store-props :type "elpher"
+                            :link link
+                            :description desc)
+      t)))
+
+(defun elpher-org-link-follow (link _args)
+  "Follow an `elpher' LINK in an `org' buffer."
+  (require 'elpher)
+  (message (concat "Got link: " link))
+  (when (or
+         (string-match-p "^gemini://.+" link)
+         (string-match-p "^gopher://.+" link)
+         (string-match-p "^finger://.+" link))
+    (elpher-go (string-remove-prefix "elpher:" link))))
+
+(org-link-set-parameters "elpher"
+                         :store #'elpher-org-link-store
+                         :follow #'elpher-org-link-follow)
+
+;;;###autoload
+(defun elpher-browse-url-elpher (url &rest _args)
+  "Browse URL using Elpher.  This function is used by `browse-url'."
+  (interactive (browse-url-interactive-arg "Elpher URL: "))
+  (elpher-go url))
+
+(add-to-list
+ 'browse-url-default-handlers
+ '("^\\(gopher\\|finger\\|gemini\\)://" . elpher-browse-url-elpher))
+
+;; Register "gemini://" as a URI scheme so `browse-url' does the right thing
+(add-to-list 'thing-at-point-uri-schemes "gemini://")
+
 ;;; Interactive procedures
 ;;
 
@@ -1720,10 +1857,19 @@ When run interactively HOST-OR-URL is read from the minibuffer."
   "Go to a particular site read from the minibuffer, initialized with the current URL."
   (interactive)
   (let ((address (elpher-page-address elpher-current-page)))
-    (if (elpher-address-special-p address)
-        (error "Command invalid for this page")
-      (let ((url (read-string "Gopher or Gemini URL: " (elpher-address-to-url address))))
-        (elpher-visit-page (elpher-make-page url (elpher-address-from-url url)))))))
+    (let ((url (read-string "Gopher or Gemini URL: "
+                            (unless (elpher-address-special-p address)
+                              (elpher-address-to-url address)))))
+      (elpher-visit-page (elpher-make-page url (elpher-address-from-url url))))))
+
+(defun elpher-visit-gemini-numbered-link (n)
+  "Visit link designated by a number N."
+  (interactive "nLink number: ")
+  (if (or (> n (length elpher--gemini-page-links))
+          (< n 1))
+      (user-error "Invalid link number"))
+  (let ((address (nth (1- n) elpher--gemini-page-links)))
+    (elpher-go (url-recreate-url address))))
 
 (defun elpher-redraw ()
   "Redraw current page."
@@ -1983,23 +2129,26 @@ When run interactively HOST-OR-URL is read from the minibuffer."
     (define-key map (kbd "B") 'elpher-bookmarks)
     (define-key map (kbd "S") 'elpher-set-gopher-coding-system)
     (define-key map (kbd "F") 'elpher-forget-current-certificate)
+    (define-key map (kbd "v") 'elpher-visit-gemini-numbered-link)
     (when (fboundp 'evil-define-key*)
       (evil-define-key* 'motion map
         (kbd "TAB") 'elpher-next-link
         (kbd "C-") 'elpher-follow-current-link
         (kbd "C-t") 'elpher-back
         (kbd "u") 'elpher-back
+        (kbd "-") 'elpher-back
+        (kbd "^") 'elpher-back
         (kbd "U") 'elpher-back-to-start
         [mouse-3] 'elpher-back
-        (kbd "g") 'elpher-go
-        (kbd "o") 'elpher-go-current
+        (kbd "o") 'elpher-go
+        (kbd "O") 'elpher-go-current
         (kbd "r") 'elpher-redraw
         (kbd "R") 'elpher-reload
         (kbd "T") 'elpher-toggle-tls
         (kbd ".") 'elpher-view-raw
         (kbd "d") 'elpher-download
         (kbd "D") 'elpher-download-current
-        (kbd "m") 'elpher-jump
+        (kbd "J") 'elpher-jump
         (kbd "i") 'elpher-info-link
         (kbd "I") 'elpher-info-current
         (kbd "c") 'elpher-copy-link-url
@@ -2010,7 +2159,8 @@ When run interactively HOST-OR-URL is read from the minibuffer."
         (kbd "X") 'elpher-unbookmark-current
         (kbd "B") 'elpher-bookmarks
         (kbd "S") 'elpher-set-gopher-coding-system
-        (kbd "F") 'elpher-forget-current-certificate))
+        (kbd "F") 'elpher-forget-current-certificate
+        (kbd "v") 'elpher-visit-gemini-numbered-link))
     map)
   "Keymap for gopher client.")
 
@@ -2020,9 +2170,14 @@ When run interactively HOST-OR-URL is read from the minibuffer."
 This mode is automatically enabled by the interactive
 functions which initialize the gopher client, namely
 `elpher', `elpher-go' and `elpher-bookmarks'."
+  (setq-local elpher--gemini-page-headings nil)
   (setq-local elpher-current-page nil)
   (setq-local elpher-history nil)
-  (setq-local elpher-buffer-name (buffer-name)))
+  (setq-local elpher-buffer-name (buffer-name))
+
+  (setq-local imenu-create-index-function
+              (lambda ()
+                elpher--gemini-page-headings)))
 
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'elpher-mode 'motion))
@@ -2037,10 +2192,10 @@ functions which initialize the gopher client, namely
 The buffer used for Elpher sessions is determined by the value of
 ‘elpher-buffer-name’.  If there is already an Elpher session active in
 that buffer, Emacs will simply switch to it.  Otherwise, a new session
-will begin.  A numeric prefix arg (as in ‘C-u 42 M-x elpher RET’)
-switches to the session with that number, creating it if necessary.  A
-nonnumeric prefix arg means to create a new session.  Returns the
-buffer selected (or created)."
+will begin.  A numeric prefix ARG (as in ‘\\[universal-argument] 42
+\\[execute-extended-command] elpher RET’) switches to the session with
+that number, creating it if necessary.  A non numeric prefix ARG means
+to create a new session.  Returns the buffer selected (or created)."
   (interactive "P")
   (let* ((name (default-value 'elpher-buffer-name))
         (buf (cond ((numberp arg)