elpher.el

   1 ;;; elpher.el --- A friendly gopher client  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2019 Tim Vaughan
   4
   5 ;; Author: Tim Vaughan <timv@ughan.xyz>
   6 ;; Created: 11 April 2019
   7 ;; Version: 2.7.1
   8 ;; Keywords: comm gopher
   9 ;; Homepage: http://thelambdalab.xyz/elpher
  10 ;; Package-Requires: ((emacs "26"))
  11
  12 ;; This file is not part of GNU Emacs.
  13
  14 ;; This program is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; Elpher aims to provide a practical and friendly gopher, gemini,
  30 ;; and finger client for GNU Emacs.  It supports:
  31
  32 ;; - intuitive keyboard and mouse-driven browsing,
  33 ;; - out-of-the-box compatibility with evil-mode,
  34 ;; - clickable web and gopher links *in plain text*,
  35 ;; - caching of visited sites,
  36 ;; - pleasant and configurable colouring of Gopher directories,
  37 ;; - direct visualisation of image files,
  38 ;; - a simple bookmark management system,
  39 ;; - connections using TLS encryption,
  40 ;; - the fledgling Gemini protocol,
  41 ;; - the greybeard Finger protocol.
  42
  43 ;; To launch Elpher, simply use 'M-x elpher'.  This will open a start
  44 ;; page containing information on key bindings and suggested starting
  45 ;; points for your gopher exploration.
  46
  47 ;; Full instructions can be found in the Elpher info manual.
  48
  49 ;; Elpher is under active development.  Any suggestions for
  50 ;; improvements are welcome, and can be made on the official
  51 ;; project page, gopher://thelambdalab.xyz/1/projects/elpher/.
  52
  53 ;;; Code:
  54
  55 (provide 'elpher)
  56
  57 ;;; Dependencies
  58 ;;
  59
  60 (require 'seq)
  61 (require 'pp)
  62 (require 'shr)
  63 (require 'url-util)
  64 (require 'subr-x)
  65 (require 'dns)
  66 (require 'ansi-color)
  67 (require 'nsm)
  68
  69
  70 ;;; Global constants
  71 ;;
  72
  73 (defconst elpher-version "2.7.1"
  74   "Current version of elpher.")
  75
  76 (defconst elpher-margin-width 6
  77   "Width of left-hand margin used when rendering indicies.")
  78
  79 (defconst elpher-type-map
  80   '(((gopher ?0) elpher-get-gopher-page elpher-render-text "txt" elpher-text)
  81     ((gopher ?1) elpher-get-gopher-page elpher-render-index "/" elpher-index)
  82     ((gopher ?4) elpher-get-gopher-page elpher-render-download "bin" elpher-binary)
  83     ((gopher ?5) elpher-get-gopher-page elpher-render-download "bin" elpher-binary)
  84     ((gopher ?7) elpher-get-gopher-query-page elpher-render-index "?" elpher-search)
  85     ((gopher ?9) elpher-get-gopher-page elpher-render-download "bin" elpher-binary)
  86     ((gopher ?g) elpher-get-gopher-page elpher-render-image "img" elpher-image)
  87     ((gopher ?p) elpher-get-gopher-page elpher-render-image "img" elpher-image)
  88     ((gopher ?I) elpher-get-gopher-page elpher-render-image "img" elpher-image)
  89     ((gopher ?d) elpher-get-gopher-page elpher-render-download "doc" elpher-binary)
  90     ((gopher ?P) elpher-get-gopher-page elpher-render-download "doc" elpher-binary)
  91     ((gopher ?s) elpher-get-gopher-page elpher-render-download "snd" elpher-binary)
  92     ((gopher ?h) elpher-get-gopher-page elpher-render-html "htm" elpher-html)
  93     (gemini elpher-get-gemini-page elpher-render-gemini "gem" elpher-gemini)
  94     (finger elpher-get-finger-page elpher-render-text "txt" elpher-text)
  95     (telnet elpher-get-telnet-page nil "tel" elpher-telnet)
  96     (other-url elpher-get-other-url-page nil "url" elpher-other-url)
  97     ((special bookmarks) elpher-get-bookmarks-page nil "/" elpher-index)
  98     ((special start) elpher-get-start-page nil))
  99   "Association list from types to getters, renderers, margin codes and index faces.")
 100
 101
 102 ;;; Customization group
 103 ;;
 104
 105 (defgroup elpher nil
 106   "A gopher client."
 107   :group 'applications)
 108
 109 ;; General appearance and customizations
 110
 111 (defcustom elpher-open-urls-with-eww nil
 112   "If non-nil, open URL selectors using eww.
 113 Otherwise, use the system browser via the BROWSE-URL function."
 114   :type '(boolean))
 115
 116 (defcustom elpher-use-header t
 117   "If non-nil, display current page information in buffer header."
 118   :type '(boolean))
 119
 120 (defcustom elpher-auto-disengage-TLS nil
 121   "If non-nil, automatically disengage TLS following an unsuccessful connection.
 122 While enabling this may seem convenient, it is also potentially dangerous as it
 123 allows switching from an encrypted channel back to plain text without user input."
 124   :type '(boolean))
 125
 126 (defcustom elpher-connection-timeout 5
 127   "Specifies the number of seconds to wait for a network connection to time out."
 128   :type '(integer))
 129
 130 (defcustom elpher-filter-ansi-from-text nil
 131   "If non-nil, filter ANSI escape sequences from text.
 132 The default behaviour is to use the ansi-color package to interpret these
 133 sequences."
 134   :type '(boolean))
 135
 136 (defcustom elpher-gemini-TLS-cert-checks nil
 137   "If non-nil, verify gemini server TLS certs using the default security level.
 138 Otherwise, certificate verification is disabled.
 139
 140 This defaults to off because it is standard practice for Gemini servers
 141 to use self-signed certificates, meaning that most servers provide what
 142 EMACS considers to be an invalid certificate."
 143   :type '(boolean))
 144
 145 (defcustom elpher-gemini-max-fill-width 80
 146   "Specify the maximum default width (in columns) of text/gemini documents.
 147 The actual width used is the minimum of this value and the window width at
 148 the time when the text is rendered."
 149   :type '(integer))
 150
 151 ;; Face customizations
 152
 153 (defgroup elpher-faces nil
 154   "Elpher face customizations."
 155   :group 'elpher)
 156
 157 (defface elpher-index
 158   '((t :inherit font-lock-keyword-face))
 159   "Face used for directory type directory records.")
 160
 161 (defface elpher-text
 162   '((t :inherit bold))
 163   "Face used for text type directory records.")
 164
 165 (defface elpher-info
 166   '((t :inherit default))
 167   "Face used for info type directory records.")
 168
 169 (defface elpher-image
 170   '((t :inherit font-lock-string-face))
 171   "Face used for image type directory records.")
 172
 173 (defface elpher-search
 174   '((t :inherit warning))
 175   "Face used for search type directory records.")
 176
 177 (defface elpher-html
 178   '((t :inherit font-lock-comment-face))
 179   "Face used for html type directory records.")
 180
 181 (defface elpher-gemini
 182   '((t :inherit font-lock-regexp-grouping-backslash))
 183   "Face used for Gemini type directory records.")
 184
 185 (defface elpher-other-url
 186   '((t :inherit font-lock-comment-face))
 187   "Face used for other URL type links records.")
 188
 189 (defface elpher-telnet
 190   '((t :inherit font-lock-function-name-face))
 191   "Face used for telnet type directory records.")
 192
 193 (defface elpher-binary
 194   '((t :inherit font-lock-doc-face))
 195   "Face used for binary type directory records.")
 196
 197 (defface elpher-unknown
 198   '((t :inherit error))
 199   "Face used for directory records with unknown/unsupported types.")
 200
 201 (defface elpher-margin-key
 202   '((t :inherit bold))
 203   "Face used for directory margin key.")
 204
 205 (defface elpher-margin-brackets
 206   '((t :inherit shadow))
 207   "Face used for brackets around directory margin key.")
 208
 209 (defface elpher-gemini-heading1
 210   '((t :inherit bold :height 1.8))
 211   "Face used for brackets around directory margin key.")
 212
 213 (defface elpher-gemini-heading2
 214   '((t :inherit bold :height 1.5))
 215   "Face used for brackets around directory margin key.")
 216
 217 (defface elpher-gemini-heading3
 218   '((t :inherit bold :height 1.2))
 219   "Face used for brackets around directory margin key.")
 220
 221 ;;; Model
 222 ;;
 223
 224 ;; Address
 225
 226 ;; An elpher "address" object is either a url object or a symbol.
 227 ;; Symbol addresses are "special", corresponding to pages generated
 228 ;; dynamically for and by elpher.  All others represent pages which
 229 ;; rely on content retrieved over the network.
 230
 231 (defun elpher-address-from-url (url-string)
 232   "Create a ADDRESS object corresponding to the given URL-STRING."
 233   (let ((data (match-data))) ; Prevent parsing clobbering match data
 234     (unwind-protect
 235         (let ((url (url-generic-parse-url url-string)))
 236           (unless (and (not (url-fullness url)) (url-type url))
 237             (setf (url-fullness url) t)
 238             (setf (url-filename url)
 239                   (url-unhex-string (url-filename url)))
 240             (unless (url-type url)
 241               (setf (url-type url) "gopher"))
 242             (when (or (equal "gopher" (url-type url))
 243                       (equal "gophers" (url-type url)))
 244               ;; Gopher defaults
 245               (unless (url-host url)
 246                 (setf (url-host url) (url-filename url))
 247                 (setf (url-filename url) ""))
 248               (when (or (equal (url-filename url) "")
 249                         (equal (url-filename url) "/"))
 250                 (setf (url-filename url) "/1")))
 251             (when (equal "gemini" (url-type url))
 252               ;; Gemini defaults
 253               (if (equal (url-filename url) "")
 254                   (setf (url-filename url) "/"))))
 255           url)
 256       (set-match-data data))))
 257
 258 (defun elpher-make-gopher-address (type selector host port &optional tls)
 259   "Create an ADDRESS object using gopher directory record attributes.
 260 The basic attributes include: TYPE, SELECTOR, HOST and PORT.
 261 If the optional attribute TLS is non-nil, the address will be marked as
 262 requiring gopher-over-TLS."
 263   (cond
 264    ((and (equal type ?h)
 265          (string-prefix-p "URL:" selector))
 266     (elpher-address-from-url (elt (split-string selector "URL:") 1)))
 267    ((equal type ?8)
 268     (elpher-address-from-url
 269      (concat "telnet"
 270              "://" host
 271              ":" (number-to-string port))))
 272    (t
 273     (elpher-address-from-url
 274      (concat "gopher" (if tls "s" "")
 275              "://" host
 276              ":" (number-to-string port)
 277              "/" (string type)
 278              selector)))))
 279
 280 (defun elpher-make-special-address (type)
 281   "Create an ADDRESS object corresponding to the given special address symbol TYPE."
 282   type)
 283
 284 (defun elpher-address-to-url (address)
 285   "Get string representation of ADDRESS, or nil if ADDRESS is special."
 286   (if (not (elpher-address-special-p address))
 287       (url-encode-url (url-recreate-url address))
 288     nil))
 289
 290 (defun elpher-address-type (address)
 291   "Retrieve type of ADDRESS object.
 292 This is used to determine how to retrieve and render the document the
 293 address refers to, via the table `elpher-type-map'."
 294   (if (symbolp address)
 295       (list 'special address)
 296     (let ((protocol (url-type address)))
 297       (cond ((or (equal protocol "gopher")
 298                  (equal protocol "gophers"))
 299              (list 'gopher
 300                    (if (member (url-filename address) '("" "/"))
 301                        ?1
 302                      (string-to-char (substring (url-filename address) 1)))))
 303             ((equal protocol "gemini")
 304              'gemini)
 305             ((equal protocol "telnet")
 306              'telnet)
 307             ((equal protocol "finger")
 308              'finger)
 309             (t 'other-url)))))
 310
 311 (defun elpher-address-protocol (address)
 312   "Retrieve the transport protocol for ADDRESS.  This is nil for special addresses."
 313   (if (symbolp address)
 314       nil
 315     (url-type address)))
 316
 317 (defun elpher-address-filename (address)
 318   "Retrieve the filename component of ADDRESS.
 319 For gopher addresses this is a combination of the selector type and selector."
 320   (if (symbolp address)
 321       nil
 322     (url-filename address)))
 323
 324 (defun elpher-address-host (address)
 325   "Retrieve host from ADDRESS object."
 326   (url-host address))
 327
 328 (defun elpher-address-user (address)
 329   "Retrieve user from ADDRESS object."
 330   (url-user address))
 331
 332 (defun elpher-address-port (address)
 333   "Retrieve port from ADDRESS object.
 334 If no address is defined, returns 0.  (This is for compatibility with the URL library.)"
 335   (if (symbolp address)
 336       0
 337     (url-port address)))
 338
 339 (defun elpher-address-special-p (address)
 340   "Return non-nil if ADDRESS object is special (e.g. start page, bookmarks page)."
 341   (symbolp address))
 342
 343 (defun elpher-address-gopher-p (address)
 344   "Return non-nill if ADDRESS object is a gopher address."
 345   (and (not (elpher-address-special-p address))
 346        (member (elpher-address-protocol address) '("gopher gophers"))))
 347
 348 (defun elpher-gopher-address-selector (address)
 349   "Retrieve gopher selector from ADDRESS object."
 350   (if (member (url-filename address) '("" "/"))
 351       ""
 352     (substring (url-filename address) 2)))
 353
 354
 355 ;; Cache
 356
 357 (defvar elpher-content-cache (make-hash-table :test 'equal))
 358 (defvar elpher-pos-cache (make-hash-table :test 'equal))
 359
 360 (defun elpher-get-cached-content (address)
 361   "Retrieve the cached content for ADDRESS, or nil if none exists."
 362   (gethash address elpher-content-cache))
 363
 364 (defun elpher-cache-content (address content)
 365   "Set the content cache for ADDRESS to CONTENT."
 366   (puthash address content elpher-content-cache))
 367
 368 (defun elpher-get-cached-pos (address)
 369   "Retrieve the cached cursor position for ADDRESS, or nil if none exists."
 370   (gethash address elpher-pos-cache))
 371
 372 (defun elpher-cache-pos (address pos)
 373   "Set the cursor position cache for ADDRESS to POS."
 374   (puthash address pos elpher-pos-cache))
 375
 376
 377 ;; Page
 378
 379 (defun elpher-make-page (display-string address)
 380   "Create a page with DISPLAY-STRING and ADDRESS."
 381   (list display-string address))
 382
 383 (defun elpher-page-display-string (page)
 384   "Retrieve the display string corresponding to PAGE."
 385   (elt page 0))
 386
 387 (defun elpher-page-address (page)
 388   "Retrieve the address corresponding to PAGE."
 389   (elt page 1))
 390
 391 (defun elpher-page-set-address (page new-address)
 392   "Set the address corresponding to PAGE to NEW-ADDRESS."
 393   (setcar (cdr page) new-address))
 394
 395 (defvar elpher-current-page nil)
 396 (defvar elpher-history nil)
 397
 398 (defun elpher-visit-page (page &optional renderer no-history)
 399   "Visit PAGE using its own renderer or RENDERER, if non-nil.
 400 Additionally, push PAGE onto the stack of previously-visited pages,
 401 unless NO-HISTORY is non-nil."
 402   (elpher-save-pos)
 403   (elpher-process-cleanup)
 404   (unless (or no-history
 405               (equal (elpher-page-address elpher-current-page)
 406                      (elpher-page-address page)))
 407     (push elpher-current-page elpher-history))
 408   (setq elpher-current-page page)
 409   (let* ((address (elpher-page-address page))
 410          (type (elpher-address-type address))
 411          (type-record (cdr (assoc type elpher-type-map))))
 412     (if type-record
 413         (funcall (car type-record)
 414                  (if renderer
 415                      renderer
 416                    (cadr type-record)))
 417       (elpher-visit-previous-page)
 418       (pcase type
 419         (`(gopher ,type-char)
 420          (error "Unsupported gopher selector type '%c' for '%s'"
 421                 type-char (elpher-address-to-url address)))
 422         (other
 423          (error "Unsupported address type '%S' for '%s'"
 424                 other (elpher-address-to-url address)))))))
 425
 426 (defun elpher-visit-previous-page ()
 427   "Visit the previous page in the history."
 428   (let ((previous-page (pop elpher-history)))
 429     (if previous-page
 430         (elpher-visit-page previous-page nil t)
 431       (error "No previous page"))))
 432
 433 (defun elpher-reload-current-page ()
 434   "Reload the current page, discarding any existing cached content."
 435   (elpher-cache-content (elpher-page-address elpher-current-page) nil)
 436   (elpher-visit-page elpher-current-page))
 437
 438 (defun elpher-save-pos ()
 439   "Save the current position of point to the current page."
 440   (when elpher-current-page
 441     (elpher-cache-pos (elpher-page-address elpher-current-page) (point))))
 442
 443 (defun elpher-restore-pos ()
 444   "Restore the position of point to that cached in the current page."
 445   (let ((pos (elpher-get-cached-pos (elpher-page-address elpher-current-page))))
 446     (if pos
 447         (goto-char pos)
 448       (goto-char (point-min)))))
 449
 450
 451 ;;; Buffer preparation
 452 ;;
 453
 454 (defun elpher-update-header ()
 455   "If `elpher-use-header' is true, display current page info in window header."
 456   (if elpher-use-header
 457       (let* ((display-string (elpher-page-display-string elpher-current-page))
 458              (address (elpher-page-address elpher-current-page))
 459              (tls-string (if (and (not (elpher-address-special-p address))
 460                                   (member (elpher-address-protocol address)
 461                                           '("gophers" "gemini")))
 462                              " [TLS encryption]"
 463                            ""))
 464              (header (concat display-string
 465                              (propertize tls-string 'face 'bold))))
 466         (setq header-line-format header))))
 467
 468 (defmacro elpher-with-clean-buffer (&rest args)
 469   "Evaluate ARGS with a clean *elpher* buffer as current."
 470   (list 'with-current-buffer "*elpher*"
 471         '(elpher-mode)
 472         (append (list 'let '((inhibit-read-only t))
 473                       '(setq-local network-security-level
 474                                    (default-value 'network-security-level))
 475                       '(erase-buffer)
 476                       '(elpher-update-header))
 477                 args)))
 478
 479
 480 ;;; Text Processing
 481 ;;
 482
 483 (defvar elpher-user-coding-system nil
 484   "User-specified coding system to use for decoding text responses.")
 485
 486 (defun elpher-decode (string)
 487   "Decode STRING using autodetected or user-specified coding system."
 488   (decode-coding-string string
 489                         (if elpher-user-coding-system
 490                             elpher-user-coding-system
 491                           (detect-coding-string string t))))
 492
 493 (defun elpher-preprocess-text-response (string)
 494   "Preprocess text selector response contained in STRING.
 495 This involes decoding the character representation, and clearing
 496 away CRs and any terminating period."
 497   (elpher-decode (replace-regexp-in-string "\n\.\n$" "\n"
 498                                            (replace-regexp-in-string "\r" "" string))))
 499
 500
 501 ;;; Network error reporting
 502 ;;
 503
 504 (defun elpher-network-error (address error)
 505   "Display ERROR message following unsuccessful negotiation with ADDRESS.
 506 ERROR can be either an error object or a string."
 507   (elpher-with-clean-buffer
 508    (insert (propertize "\n---- ERROR -----\n\n" 'face 'error)
 509            "When attempting to retrieve " (elpher-address-to-url address) ":\n"
 510            (if (stringp error) error (error-message-string error)) "\n"
 511            (propertize "\n----------------\n\n" 'face 'error)
 512            "Press 'u' to return to the previous page.")))
 513
 514
 515 ;;; Gopher selector retrieval
 516 ;;
 517
 518 (defvar elpher-network-timer nil
 519   "Timer used for network connections.")
 520
 521 (defun elpher-process-cleanup ()
 522   "Immediately shut down any extant elpher process and timers."
 523   (let ((p (get-process "elpher-process")))
 524     (if p (delete-process p)))
 525   (if (timerp elpher-network-timer)
 526       (cancel-timer elpher-network-timer)))
 527
 528 (defvar elpher-use-tls nil
 529   "If non-nil, use TLS to communicate with gopher servers.")
 530
 531 (defun elpher-get-selector (address renderer &optional force-ipv4)
 532   "Retrieve selector specified by ADDRESS, then render it using RENDERER.
 533 If FORCE-IPV4 is non-nil, explicitly look up and use IPv4 address corresponding
 534 to ADDRESS."
 535   (when (equal (elpher-address-protocol address) "gophers")
 536     (if (gnutls-available-p)
 537         (when (not elpher-use-tls)
 538           (setq elpher-use-tls t)
 539           (message "Engaging TLS gopher mode."))
 540       (error "Cannot retrieve TLS gopher selector: GnuTLS not available")))
 541   (unless (< (elpher-address-port address) 65536)
 542     (error "Cannot retrieve gopher selector: port number > 65536"))
 543   (condition-case nil
 544       (let* ((kill-buffer-query-functions nil)
 545              (port (elpher-address-port address))
 546              (host (elpher-address-host address))
 547              (selector-string-parts nil)
 548              (proc (open-network-stream "elpher-process"
 549                                         nil
 550                                         (if force-ipv4 (dns-query host) host)
 551                                         (if (> port 0) port 70)
 552                                         :type (if elpher-use-tls 'tls 'plain)
 553                                         :nowait t))
 554              (timer (run-at-time elpher-connection-timeout
 555                                  nil
 556                                  (lambda ()
 557                                    (pcase (process-status proc)
 558                                      ('failed
 559                                       (if (and (not (equal (elpher-address-protocol address)
 560                                                            "gophers"))
 561                                                elpher-use-tls
 562                                                (or elpher-auto-disengage-TLS
 563                                                    (yes-or-no-p "Could not establish encrypted connection.  Disable TLS mode?")))
 564                                           (progn
 565                                             (message "Disabling TLS mode.")
 566                                             (setq elpher-use-tls nil)
 567                                             (elpher-get-selector address renderer))
 568                                         (elpher-network-error address "Could not establish encrypted connection")))
 569                                      ('connect
 570                                       (elpher-process-cleanup)
 571                                       (unless force-ipv4
 572                                         (message "Connection timed out. Retrying with IPv4 address.")
 573                                         (elpher-get-selector address renderer t))))))))
 574         (setq elpher-network-timer timer)
 575         (set-process-coding-system proc 'binary)
 576         (set-process-filter proc
 577                             (lambda (_proc string)
 578                               (cancel-timer timer)
 579                               (setq selector-string-parts
 580                                     (cons string selector-string-parts))))
 581         (set-process-sentinel proc
 582                               (lambda (_proc event)
 583                                 (condition-case the-error
 584                                     (cond
 585                                      ((string-prefix-p "deleted" event))
 586                                      ((string-prefix-p "open" event)
 587                                       (let ((inhibit-eol-conversion t))
 588                                         (process-send-string
 589                                          proc
 590                                          (concat (elpher-gopher-address-selector address)
 591                                                  "\r\n"))))
 592                                      (t
 593                                       (cancel-timer timer)
 594                                       (funcall renderer (apply #'concat
 595                                                                (reverse selector-string-parts)))
 596                                       (elpher-restore-pos)))
 597                                   (error
 598                                    (elpher-network-error address the-error))))))
 599     (error
 600      (error "Error initiating connection to server"))))
 601
 602 (defun elpher-get-gopher-page (renderer)
 603   "Getter function for gopher pages.
 604 The RENDERER procedure is used to display the contents of the page
 605 once they are retrieved from the gopher server."
 606   (let* ((address (elpher-page-address elpher-current-page))
 607          (content (elpher-get-cached-content address)))
 608     (if (and content (funcall renderer nil))
 609         (elpher-with-clean-buffer
 610          (insert content)
 611          (elpher-restore-pos))
 612       (elpher-with-clean-buffer
 613        (insert "LOADING... (use 'u' to cancel)"))
 614       (condition-case the-error
 615           (elpher-get-selector address renderer)
 616         (error
 617          (elpher-network-error address the-error))))))
 618
 619 ;; Index rendering
 620
 621 (defun elpher-insert-index (string)
 622   "Insert the index corresponding to STRING into the current buffer."
 623   ;; Should be able to split directly on CRLF, but some non-conformant
 624   ;; LF-only servers sadly exist, hence the following.
 625   (let ((str-processed (elpher-preprocess-text-response string)))
 626     (dolist (line (split-string str-processed "\n"))
 627       (ignore-errors
 628         (unless (= (length line) 0)
 629           (let* ((type (elt line 0))
 630                  (fields (split-string (substring line 1) "\t"))
 631                  (display-string (elt fields 0))
 632                  (selector (elt fields 1))
 633                  (host (elt fields 2))
 634                  (port (if (elt fields 3)
 635                            (string-to-number (elt fields 3))
 636                          nil))
 637                  (address (elpher-make-gopher-address type selector host port)))
 638             (elpher-insert-index-record display-string address)))))))
 639
 640 (defun elpher-insert-margin (&optional type-name)
 641   "Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
 642   (if type-name
 643       (progn
 644         (insert (format (concat "%" (number-to-string (- elpher-margin-width 1)) "s")
 645                         (concat
 646                          (propertize "[" 'face 'elpher-margin-brackets)
 647                          (propertize type-name 'face 'elpher-margin-key)
 648                          (propertize "]" 'face 'elpher-margin-brackets))))
 649         (insert " "))
 650     (insert (make-string elpher-margin-width ?\s))))
 651
 652 (defun elpher-page-button-help (page)
 653   "Return a string containing the help text for a button corresponding to PAGE."
 654   (let ((address (elpher-page-address page)))
 655     (format "mouse-1, RET: open '%s'" (if (elpher-address-special-p address)
 656                                           address
 657                                         (elpher-address-to-url address)))))
 658
 659 (defun elpher-insert-index-record (display-string &optional address)
 660   "Function to insert an index record into the current buffer.
 661 The contents of the record are dictated by DISPLAY-STRING and ADDRESS.
 662 If ADDRESS is not supplied or nil the record is rendered as an
 663 'information' line."
 664   (let* ((type (if address (elpher-address-type address) nil))
 665          (type-map-entry (cdr (assoc type elpher-type-map))))
 666     (if type-map-entry
 667         (let* ((margin-code (elt type-map-entry 2))
 668                (face (elt type-map-entry 3))
 669                (filtered-display-string (ansi-color-filter-apply display-string))
 670                (page (elpher-make-page filtered-display-string address)))
 671           (elpher-insert-margin margin-code)
 672           (insert-text-button filtered-display-string
 673                               'face face
 674                               'elpher-page page
 675                               'action #'elpher-click-link
 676                               'follow-link t
 677                               'help-echo (elpher-page-button-help page)))
 678       (pcase type
 679         ((or '(gopher ?i) 'nil) ;; Information
 680          (elpher-insert-margin)
 681          (let ((propertized-display-string
 682                 (propertize display-string 'face 'elpher-info)))
 683            (insert (elpher-process-text-for-display propertized-display-string))))
 684         (`(gopher ,selector-type) ;; Unknown
 685          (elpher-insert-margin (concat (char-to-string selector-type) "?"))
 686          (insert (propertize display-string
 687                              'face 'elpher-unknown)))))
 688     (insert "\n")))
 689
 690 (defun elpher-click-link (button)
 691   "Function called when the gopher link BUTTON is activated (via mouse or keypress)."
 692   (let ((page (button-get button 'elpher-page)))
 693     (elpher-visit-page page)))
 694
 695 (defun elpher-render-index (data &optional _mime-type-string)
 696   "Render DATA as an index.  MIME-TYPE-STRING is unused."
 697   (elpher-with-clean-buffer
 698    (if (not data)
 699        t
 700      (elpher-insert-index data)
 701      (elpher-cache-content (elpher-page-address elpher-current-page)
 702                            (buffer-string)))))
 703
 704 ;; Text rendering
 705
 706 (defconst elpher-url-regex
 707   "\\([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\-_~?/@|#]\\)?\\)?"
 708   "Regexp used to locate and buttinofy URLs in text files loaded by elpher.")
 709
 710 (defun elpher-buttonify-urls (string)
 711   "Turn substrings which look like urls in STRING into clickable buttons."
 712   (with-temp-buffer
 713     (insert string)
 714     (goto-char (point-min))
 715     (while (re-search-forward elpher-url-regex nil t)
 716       (let ((page (elpher-make-page (substring-no-properties (match-string 0))
 717                                     (elpher-address-from-url (match-string 0)))))
 718           (make-text-button (match-beginning 0)
 719                             (match-end 0)
 720                             'elpher-page  page
 721                             'action #'elpher-click-link
 722                             'follow-link t
 723                             'help-echo (elpher-page-button-help page)
 724                             'face 'button)))
 725     (buffer-string)))
 726
 727 (defconst elpher-ansi-regex "\x1b\\[[^m]*m"
 728   "Wildly incomplete regexp used to strip out some troublesome ANSI escape sequences.")
 729
 730 (defun elpher-process-text-for-display (string)
 731   "Perform any desired processing of STRING prior to display as text.
 732 Currently includes buttonifying URLs and processing ANSI escape codes."
 733   (elpher-buttonify-urls (if elpher-filter-ansi-from-text
 734                              (ansi-color-filter-apply string)
 735                            (ansi-color-apply string))))
 736
 737 (defun elpher-render-text (data &optional _mime-type-string)
 738   "Render DATA as text.  MIME-TYPE-STRING is unused."
 739   (elpher-with-clean-buffer
 740    (if (not data)
 741        t
 742      (insert (elpher-process-text-for-display (elpher-preprocess-text-response data)))
 743      (elpher-cache-content
 744       (elpher-page-address elpher-current-page)
 745       (buffer-string)))))
 746
 747 ;; Image retrieval
 748
 749 (defun elpher-render-image (data &optional _mime-type-string)
 750   "Display DATA as image.  MIME-TYPE-STRING is unused."
 751   (if (not data)
 752       nil
 753     (if (display-images-p)
 754         (progn
 755           (let ((image (create-image
 756                         data
 757                         nil t)))
 758             (elpher-with-clean-buffer
 759              (insert-image image)
 760              (elpher-restore-pos))))
 761       (elpher-render-download data))))
 762
 763 ;; Search retrieval and rendering
 764
 765 (defun elpher-get-gopher-query-page (renderer)
 766   "Getter for gopher addresses requiring input.
 767 The response is rendered using the rendering function RENDERER."
 768    (let* ((address (elpher-page-address elpher-current-page))
 769           (content (elpher-get-cached-content address))
 770           (aborted t))
 771     (if (and content (funcall renderer nil))
 772         (elpher-with-clean-buffer
 773          (insert content)
 774          (elpher-restore-pos)
 775          (message "Displaying cached search results.  Reload to perform a new search."))
 776       (unwind-protect
 777           (let* ((query-string (read-string "Query: "))
 778                  (query-selector (concat (elpher-gopher-address-selector address) "\t" query-string))
 779                  (search-address (elpher-make-gopher-address ?1
 780                                                              query-selector
 781                                                              (elpher-address-host address)
 782                                                              (elpher-address-port address)
 783                                                              (equal (elpher-address-type address) "gophers"))))
 784             (setq aborted nil)
 785
 786             (elpher-with-clean-buffer
 787              (insert "LOADING RESULTS... (use 'u' to cancel)"))
 788             (elpher-get-selector search-address renderer))
 789         (if aborted
 790             (elpher-visit-previous-page))))))
 791
 792 ;; Raw server response rendering
 793
 794 (defun elpher-render-raw (data &optional mime-type-string)
 795   "Display raw DATA in buffer.  MIME-TYPE-STRING is also displayed if provided."
 796   (if (not data)
 797       nil
 798     (elpher-with-clean-buffer
 799      (when mime-type-string
 800        (insert "MIME type specified by server: '" mime-type-string "'\n"))
 801      (insert data)
 802      (goto-char (point-min)))
 803     (message "Displaying raw server response.  Reload or redraw to return to standard view.")))
 804
 805 ;; File save "rendering"
 806
 807 (defun elpher-render-download (data &optional _mime-type-string)
 808   "Save DATA to file.  MIME-TYPE-STRING is unused."
 809   (if (not data)
 810       nil
 811     (let* ((address (elpher-page-address elpher-current-page))
 812            (selector (elpher-gopher-address-selector address)))
 813       (elpher-visit-previous-page) ; Do first in case of non-local exits.
 814       (let* ((filename-proposal (file-name-nondirectory selector))
 815              (filename (read-file-name "Download complete. Save file as: "
 816                                        nil nil nil
 817                                        (if (> (length filename-proposal) 0)
 818                                            filename-proposal
 819                                          "download.file"))))
 820         (let ((coding-system-for-write 'binary))
 821           (with-temp-file filename
 822             (insert data)))
 823         (message (format "Saved to file %s." filename))))))
 824
 825 ;; HTML rendering
 826
 827 (defun elpher-render-html (data &optional _mime-type-string)
 828   "Render DATA as HTML using shr.  MIME-TYPE-STRING is unused."
 829   (elpher-with-clean-buffer
 830    (if (not data)
 831        t
 832      (let ((dom (with-temp-buffer
 833                   (insert data)
 834                   (libxml-parse-html-region (point-min) (point-max)))))
 835        (shr-insert-document dom)))))
 836
 837 ;; Gemini page retrieval
 838
 839 (defvar elpher-gemini-redirect-chain)
 840
 841 (defun elpher-get-gemini-response (address renderer &optional force-ipv4)
 842   "Retrieve gemini ADDRESS, then render using RENDERER.
 843 If FORCE-IPV4 is non-nil, explicitly look up and use IPv4 address corresponding
 844 to ADDRESS."
 845   (unless elpher-gemini-TLS-cert-checks
 846     (setq-local network-security-level 'low))
 847   (if (not (gnutls-available-p))
 848       (error "Cannot establish gemini connection: GnuTLS not available")
 849     (unless (< (elpher-address-port address) 65536)
 850       (error "Cannot establish gemini connection: port number > 65536"))
 851     (condition-case nil
 852         (let* ((kill-buffer-query-functions nil)
 853                (port (elpher-address-port address))
 854                (host (elpher-address-host address))
 855                (response-string-parts nil)
 856                (proc (open-network-stream "elpher-process"
 857                                           nil
 858                                           (if force-ipv4 (dns-query host) host)
 859                                           (if (> port 0) port 1965)
 860                                           :type 'tls
 861                                           :nowait t))
 862                (timer (run-at-time elpher-connection-timeout nil
 863                                    (lambda ()
 864                                      (elpher-process-cleanup)
 865                                      (unless force-ipv4
 866                                         ; Try again with IPv4
 867                                        (message "Connection timed out.  Retrying with IPv4.")
 868                                        (elpher-get-gemini-response address renderer t))))))
 869           (setq elpher-network-timer timer)
 870           (set-process-coding-system proc 'binary)
 871           (set-process-filter proc
 872                               (lambda (_proc string)
 873                                 (when timer
 874                                   (cancel-timer timer)
 875                                   (setq timer nil))
 876                                 (setq response-string-parts
 877                                       (cons string response-string-parts))))
 878           (set-process-sentinel proc
 879                                 (lambda (proc event)
 880                                   (condition-case the-error
 881                                       (cond
 882                                        ((string-prefix-p "open" event)    ; request URL
 883                                         (let ((inhibit-eol-conversion t))
 884                                           (process-send-string
 885                                            proc
 886                                            (concat (elpher-address-to-url address)
 887                                                    "\r\n"))))
 888                                        ((string-prefix-p "deleted" event)) ; do nothing
 889                                        ((and (not response-string-parts)
 890                                              (not force-ipv4))
 891                                         ; Try again with IPv4
 892                                         (message "Connection failed. Retrying with IPv4.")
 893                                         (cancel-timer timer)
 894                                         (elpher-get-gemini-response address renderer t))
 895                                        (t
 896                                         (funcall #'elpher-process-gemini-response
 897                                                  (apply #'concat (reverse response-string-parts))
 898                                                  renderer)
 899                                         (elpher-restore-pos)))
 900                                     (error
 901                                            (elpher-network-error address the-error))))))
 902       (error
 903        (error "Error initiating connection to server")))))
 904
 905 (defun elpher-parse-gemini-response (response)
 906   "Parse the RESPONSE string and return a list of components.
 907 The list is of the form (code meta body).  A response of nil implies
 908 that the response was malformed."
 909   (let ((header-end-idx (string-match "\r\n" response)))
 910     (if header-end-idx
 911         (let ((header (string-trim (substring response 0 header-end-idx)))
 912               (body (substring response (+ header-end-idx 2))))
 913           (if (>= (length header) 2)
 914               (let ((code (substring header 0 2))
 915                     (meta (string-trim (substring header 2))))
 916                 (list code meta body))
 917             (error "Malformed response: No response status found in header %s" header)))
 918       (error "Malformed response: No CRLF-delimited header found"))))
 919
 920 (defun elpher-process-gemini-response (response-string renderer)
 921   "Process the gemini response RESPONSE-STRING and pass the result to RENDERER."
 922   (let ((response-components (elpher-parse-gemini-response response-string)))
 923     (let ((response-code (elt response-components 0))
 924           (response-meta (elt response-components 1))
 925           (response-body (elt response-components 2)))
 926       (pcase (elt response-code 0)
 927         (?1 ; Input required
 928          (elpher-with-clean-buffer
 929           (insert "Gemini server is requesting input."))
 930          (let* ((query-string (read-string (concat response-meta ": ")))
 931                 (url (elpher-address-to-url (elpher-page-address elpher-current-page)))
 932                 (query-address (elpher-address-from-url (concat url "?" query-string))))
 933            (elpher-get-gemini-response query-address renderer)))
 934         (?2 ; Normal response
 935          (funcall renderer response-body response-meta))
 936         (?3 ; Redirect
 937          (message "Following redirect to %s" response-meta)
 938          (if (>= (length elpher-gemini-redirect-chain) 5)
 939              (error "More than 5 consecutive redirects followed"))
 940          (let ((redirect-address (elpher-address-from-gemini-url response-meta)))
 941            (if (member redirect-address elpher-gemini-redirect-chain)
 942                (error "Redirect loop detected"))
 943            (if (not (string= (elpher-address-protocol redirect-address)
 944                              "gemini"))
 945                (error "Server tried to automatically redirect to non-gemini URL: %s"
 946                       response-meta))
 947            (elpher-page-set-address elpher-current-page redirect-address)
 948            (add-to-list 'elpher-gemini-redirect-chain redirect-address)
 949            (elpher-get-gemini-response redirect-address renderer)))
 950         (?4 ; Temporary failure
 951          (error "Gemini server reports TEMPORARY FAILURE for this request: %s %s"
 952                 response-code response-meta))
 953         (?5 ; Permanent failure
 954          (error "Gemini server reports PERMANENT FAILURE for this request: %s %s"
 955                 response-code response-meta))
 956         (?6 ; Client certificate required
 957          (error "Gemini server requires client certificate (unsupported at this time)"))
 958         (_other
 959          (error "Gemini server response unknown: %s %s"
 960                 response-code response-meta))))))
 961
 962 (defun elpher-get-gemini-page (renderer)
 963   "Getter which retrieves and renders a Gemini page and renders it using RENDERER."
 964   (let* ((address (elpher-page-address elpher-current-page))
 965          (content (elpher-get-cached-content address)))
 966     (condition-case the-error
 967         (if (and content (funcall renderer nil))
 968             (elpher-with-clean-buffer
 969               (insert content)
 970               (elpher-restore-pos))
 971           (elpher-with-clean-buffer
 972            (insert "LOADING GEMINI... (use 'u' to cancel)"))
 973           (setq elpher-gemini-redirect-chain nil)
 974           (elpher-get-gemini-response address renderer))
 975       (error
 976        (elpher-network-error address the-error)))))
 977
 978
 979 (defun elpher-render-gemini (body &optional mime-type-string)
 980   "Render gemini response BODY with rendering MIME-TYPE-STRING."
 981   (if (not body)
 982       t
 983     (let* ((mime-type-string* (if (or (not mime-type-string)
 984                                       (string-empty-p mime-type-string))
 985                                   "text/gemini; charset=utf-8"
 986                                 mime-type-string))
 987            (mime-type-split (split-string mime-type-string* ";" t))
 988            (mime-type (string-trim (car mime-type-split)))
 989            (parameters (mapcar (lambda (s)
 990                                  (let ((key-val (split-string s "=")))
 991                                    (list (downcase (string-trim (car key-val)))
 992                                          (downcase (string-trim (cadr key-val))))))
 993                                (cdr mime-type-split))))
 994       (when (string-prefix-p "text/" mime-type)
 995         (setq body (decode-coding-string
 996                     body
 997                     (if (assoc "charset" parameters)
 998                         (intern (cadr (assoc "charset" parameters)))
 999                       'utf-8)))
1000         (setq body (replace-regexp-in-string "\r" "" body)))
1001       (pcase mime-type
1002         ((or "text/gemini" "")
1003          (elpher-render-gemini-map body parameters))
1004         ("text/html"
1005          (elpher-render-html body))
1006         ((pred (string-prefix-p "text/"))
1007          (elpher-render-gemini-plain-text body parameters))
1008         ((pred (string-prefix-p "image/"))
1009          (elpher-render-image body))
1010         (_other
1011          (error "Unsupported MIME type %S" mime-type))))))
1012
1013 (defun elpher-gemini-get-link-url (link-line)
1014   "Extract the url portion of LINK-LINE, a gemini map file link line.
1015 Returns nil in the event that the contents of the line following the
1016 => prefix are empty."
1017   (let ((l (split-string (substring link-line 2))))
1018     (if l
1019         (string-trim (elt l 0))
1020       nil)))
1021
1022 (defun elpher-gemini-get-link-display-string (link-line)
1023   "Extract the display string portion of LINK-LINE, a gemini map file link line.
1024 Returns the url portion in the event that the display-string portion is empty."
1025   (let* ((rest (string-trim (elt (split-string link-line "=>") 1)))
1026          (idx (string-match "[ \t]" rest)))
1027     (string-trim (if idx
1028                      (substring rest (+ idx 1))
1029                    rest))))
1030
1031 (defun elpher-collapse-dot-sequences (filename)
1032   "Collapse dot sequences in FILENAME.
1033 For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
1034   (let* ((path (split-string filename "/"))
1035          (path-reversed-normalized
1036           (seq-reduce (lambda (a b)
1037                         (cond ((and a (equal b "..") (cdr a)))
1038                               ((and (not a) (equal b "..")) a) ;leading .. are dropped
1039                               ((equal b ".") a)
1040                               (t (cons b a))))
1041                       path nil)))
1042     (string-join (reverse path-reversed-normalized) "/")))
1043
1044 (defun elpher-address-from-gemini-url (url)
1045   "Extract address from URL with defaults as per gemini map files."
1046   (let ((address (url-generic-parse-url url)))
1047     (unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls
1048       (setf (url-fullness address) t)
1049       (if (url-host address) ;if there is an explicit host, filenames are absolute
1050           (if (string-empty-p (url-filename address))
1051               (setf (url-filename address) "/")) ;ensure empty filename is marked as absolute
1052         (setf (url-host address) (url-host (elpher-page-address elpher-current-page)))
1053         (unless (string-prefix-p "/" (url-filename address)) ;deal with relative links
1054           (setf (url-filename address)
1055                 (concat (file-name-directory
1056                          (url-filename (elpher-page-address elpher-current-page)))
1057                         (url-filename address)))))
1058       (unless (url-type address)
1059         (setf (url-type address) "gemini"))
1060       (if (equal (url-type address) "gemini")
1061           (setf (url-filename address)
1062                 (elpher-collapse-dot-sequences (url-filename address)))))
1063     address))
1064
1065 (defun elpher-gemini-insert-link (link-line)
1066   "Insert link described by LINK-LINE into a text/gemini document."
1067   (let* ((url (elpher-gemini-get-link-url link-line))
1068          (display-string (elpher-gemini-get-link-display-string link-line))
1069          (address (elpher-address-from-gemini-url url))
1070          (type (if address (elpher-address-type address) nil))
1071          (type-map-entry (cdr (assoc type elpher-type-map))))
1072     (when display-string
1073       (insert "→ ")
1074       (if type-map-entry
1075           (let* ((face (elt type-map-entry 3))
1076                  (filtered-display-string (ansi-color-filter-apply display-string))
1077                  (page (elpher-make-page filtered-display-string address)))
1078             (insert-text-button filtered-display-string
1079                                 'face face
1080                                 'elpher-page page
1081                                 'action #'elpher-click-link
1082                                 'follow-link t
1083                                 'help-echo (elpher-page-button-help page)))
1084         (insert (propertize display-string 'face 'elpher-unknown)))
1085       (insert "\n"))))
1086
1087 (defun elpher-gemini-insert-header (header-line)
1088   "Insert header described by HEADER-LINE into a text/gemini document.
1089 The gemini map file line describing the header is given
1090 by HEADER-LINE."
1091   (when (string-match "^\\(#+\\)[ \t]*" header-line)
1092     (let ((level (length (match-string 1 header-line)))
1093           (header (substring header-line (match-end 0))))
1094       (unless (display-graphic-p)
1095         (insert (make-string level ?#) " "))
1096       (insert (propertize header 'face
1097                           (pcase level
1098                             (1 'elpher-gemini-heading1)
1099                             (2 'elpher-gemini-heading2)
1100                             (3 'elpher-gemini-heading3)
1101                             (_ 'default)))
1102               "\n"))))
1103
1104 (defun elpher-render-gemini-map (data _parameters)
1105   "Render DATA as a gemini map file, PARAMETERS is currently unused."
1106   (elpher-with-clean-buffer
1107    (let ((preformatted nil))
1108      (auto-fill-mode 1)
1109      (setq-local fill-column (min (window-width) elpher-gemini-max-fill-width))
1110      (dolist (line (split-string data "\n"))
1111        (cond
1112         ((string-prefix-p "```" line) (setq preformatted (not preformatted)))
1113         (preformatted (insert (elpher-process-text-for-display line) "\n"))
1114         ((string-prefix-p "=>" line) (elpher-gemini-insert-link line))
1115         ((string-prefix-p "#" line) (elpher-gemini-insert-header line))
1116         (t (insert (elpher-process-text-for-display line)) (newline)))))
1117    (elpher-cache-content
1118     (elpher-page-address elpher-current-page)
1119     (buffer-string))))
1120
1121 (defun elpher-render-gemini-plain-text (data _parameters)
1122   "Render DATA as plain text file.  PARAMETERS is currently unused."
1123   (elpher-with-clean-buffer
1124    (insert (elpher-process-text-for-display data))
1125    (elpher-cache-content
1126     (elpher-page-address elpher-current-page)
1127     (buffer-string))))
1128
1129 ;; Finger page connection
1130
1131 (defun elpher-get-finger-page (renderer &optional force-ipv4)
1132   "Opens a finger connection to the current page address and renders it using RENDERER."
1133   (let* ((address (elpher-page-address elpher-current-page))
1134          (content (elpher-get-cached-content address)))
1135     (if (and content (funcall renderer nil))
1136         (elpher-with-clean-buffer
1137          (insert content)
1138          (elpher-restore-pos))
1139       (elpher-with-clean-buffer
1140        (insert "LOADING... (use 'u' to cancel)"))
1141       (condition-case the-error
1142           (let* ((kill-buffer-query-functions nil)
1143                  (user (let ((filename (elpher-address-filename address)))
1144                          (if (> (length filename) 1)
1145                              (substring filename 1)
1146                            (elpher-address-user address))))
1147                  (port (let ((given-port (elpher-address-port address)))
1148                          (if (> given-port 0) given-port 79)))
1149                  (host (elpher-address-host address))
1150                  (selector-string-parts nil)
1151                  (proc (open-network-stream "elpher-process"
1152                                             nil
1153                                             (if force-ipv4 (dns-query host) host)
1154                                             port
1155                                             :type 'plain
1156                                             :nowait t))
1157                  (timer (run-at-time elpher-connection-timeout
1158                                      nil
1159                                      (lambda ()
1160                                        (pcase (process-status proc)
1161                                          ('connect
1162                                           (elpher-process-cleanup)
1163                                           (unless force-ipv4
1164                                             (message "Connection timed out. Retrying with IPv4 address.")
1165                                             (elpher-get-finger-page renderer t))))))))
1166             (setq elpher-network-timer timer)
1167             (set-process-coding-system proc 'binary)
1168             (set-process-filter proc
1169                                 (lambda (_proc string)
1170                                   (cancel-timer timer)
1171                                   (setq selector-string-parts
1172                                         (cons string selector-string-parts))))
1173             (set-process-sentinel proc
1174                                   (lambda (_proc event)
1175                                     (condition-case the-error
1176                                         (cond
1177                                          ((string-prefix-p "deleted" event))
1178                                          ((string-prefix-p "open" event)
1179                                           (let ((inhibit-eol-conversion t))
1180                                             (process-send-string
1181                                              proc
1182                                              (concat user "\r\n"))))
1183                                          (t
1184                                           (cancel-timer timer)
1185                                           (funcall renderer (apply #'concat
1186                                                                    (reverse selector-string-parts)))
1187                                           (elpher-restore-pos)))))))
1188         (error
1189          (elpher-network-error address the-error))))))
1190
1191
1192 ;; Other URL page opening
1193
1194 (defun elpher-get-other-url-page (renderer)
1195   "Getter which attempts to open the URL specified by the current page (RENDERER must be nil)."
1196   (when renderer
1197     (elpher-visit-previous-page)
1198     (error "Command not supported for general URLs"))
1199   (let* ((address (elpher-page-address elpher-current-page))
1200          (url (elpher-address-to-url address)))
1201     (progn
1202       (elpher-visit-previous-page) ; Do first in case of non-local exits.
1203       (message "Opening URL...")
1204       (if elpher-open-urls-with-eww
1205           (browse-web url)
1206         (browse-url url)))))
1207
1208 ;; Telnet page connection
1209
1210 (defun elpher-get-telnet-page (renderer)
1211   "Opens a telnet connection to the current page address (RENDERER must be nil)."
1212   (when renderer
1213     (elpher-visit-previous-page)
1214     (error "Command not supported for telnet URLs"))
1215   (let* ((address (elpher-page-address elpher-current-page))
1216          (host (elpher-address-host address))
1217          (port (elpher-address-port address)))
1218     (elpher-visit-previous-page)
1219     (if (> port 0)
1220         (telnet host port)
1221       (telnet host))))
1222
1223 ;; Start page page retrieval
1224
1225 (defun elpher-get-start-page (renderer)
1226   "Getter which displays the start page (RENDERER must be nil)."
1227   (when renderer
1228     (elpher-visit-previous-page)
1229     (error "Command not supported for start page"))
1230   (elpher-with-clean-buffer
1231    (insert "     --------------------------------------------\n"
1232            "                Elpher Gopher Client             \n"
1233            "                   version " elpher-version "\n"
1234            "     --------------------------------------------\n"
1235            "\n"
1236            "Default bindings:\n"
1237            "\n"
1238            " - TAB/Shift-TAB: next/prev item on current page\n"
1239            " - RET/mouse-1: open item under cursor\n"
1240            " - m: select an item on current page by name (autocompletes)\n"
1241            " - u/mouse-3: return to previous page\n"
1242            " - o/O: visit different selector or the root menu of the current server\n"
1243            " - g: go to a particular address (gopher, gemini, finger)\n"
1244            " - d/D: download item under cursor or current page\n"
1245            " - i/I: info on item under cursor or current page\n"
1246            " - c/C: copy URL representation of item under cursor or current page\n"
1247            " - a/A: bookmark the item under cursor or current page\n"
1248            " - x/X: remove bookmark for item under cursor or current page\n"
1249            " - B: visit the bookmarks page\n"
1250            " - r: redraw current page (using cached contents if available)\n"
1251            " - R: reload current page (regenerates cache)\n"
1252            " - S: set character coding system for gopher (default is to autodetect)\n"
1253            " - T: toggle TLS gopher mode\n"
1254            " - .: display the raw server response for the current page\n"
1255            "\n"
1256            "Start your exploration of gopher space:\n")
1257    (elpher-insert-index-record "Floodgap Systems Gopher Server"
1258                                (elpher-make-gopher-address ?1 "" "gopher.floodgap.com" 70))
1259    (insert "\n"
1260            "Alternatively, select a search engine and enter some search terms:\n")
1261    (elpher-insert-index-record "GUS Gemini Search Engine"
1262                                (elpher-address-from-url "gemini://gus.guru/search"))
1263    (elpher-insert-index-record "Veronica-2 Gopher Search Engine"
1264                                (elpher-make-gopher-address ?7 "/v2/vs" "gopher.floodgap.com" 70))
1265    (insert "\n"
1266            "This page contains your bookmarked sites (also visit with B):\n")
1267    (elpher-insert-index-record "Your Bookmarks" 'bookmarks)
1268    (insert "\n"
1269            "For Elpher release news or to leave feedback, visit:\n")
1270    (elpher-insert-index-record "The Elpher Project Page"
1271                                (elpher-make-gopher-address ?1
1272                                                            "/projects/elpher/"
1273                                                            "thelambdalab.xyz"
1274                                                            70))
1275    (insert "\n"
1276            "** Refer to the ")
1277    (let ((help-string "RET,mouse-1: Open Elpher info manual (if available)"))
1278      (insert-text-button "Elpher info manual"
1279                          'face 'link
1280                          'action (lambda (_)
1281                                    (interactive)
1282                                    (info "(elpher)"))
1283                          'follow-link t
1284                          'help-echo help-string))
1285    (insert " for the full documentation. **\n")
1286    (insert (propertize
1287             (concat "  (This should be available if you have installed Elpher using\n"
1288                     "   MELPA. Otherwise you will have to install the manual yourself.)\n")
1289             'face 'shadow))
1290    (elpher-restore-pos)))
1291
1292 ;; Bookmarks page page retrieval
1293
1294 (defun elpher-get-bookmarks-page (renderer)
1295   "Getter to load and display the current bookmark list (RENDERER must be nil)."
1296   (when renderer
1297     (elpher-visit-previous-page)
1298     (error "Command not supported for bookmarks page"))
1299   (elpher-with-clean-buffer
1300    (insert "---- Bookmark list ----\n\n")
1301    (let ((bookmarks (elpher-load-bookmarks)))
1302      (if bookmarks
1303          (dolist (bookmark bookmarks)
1304            (let ((display-string (elpher-bookmark-display-string bookmark))
1305                  (address (elpher-address-from-url (elpher-bookmark-url bookmark))))
1306              (elpher-insert-index-record display-string address)))
1307        (insert "No bookmarks found.\n")))
1308    (insert "\n-----------------------\n"
1309            "\n"
1310            "- u: return to previous page\n"
1311            "- x: delete selected bookmark\n"
1312            "- a: rename selected bookmark\n"
1313            "\n"
1314            "Bookmarks are stored in the file ")
1315    (let ((filename (locate-user-emacs-file "elpher-bookmarks"))
1316          (help-string "RET,mouse-1: Open bookmarks file in new buffer for editing."))
1317      (insert-text-button filename
1318                          'face 'link
1319                          'action (lambda (_)
1320                                    (interactive)
1321                                    (find-file filename))
1322                          'follow-link t
1323                          'help-echo help-string))
1324    (insert "\n")
1325    (elpher-restore-pos)))
1326
1327
1328 ;;; Bookmarks
1329 ;;
1330
1331 (defun elpher-make-bookmark (display-string url)
1332   "Make an elpher bookmark.
1333 DISPLAY-STRING determines how the bookmark will appear in the
1334 bookmark list, while URL is the url of the entry."
1335   (list display-string url))
1336
1337 (defun elpher-bookmark-display-string (bookmark)
1338   "Get the display string of BOOKMARK."
1339   (elt bookmark 0))
1340
1341 (defun elpher-set-bookmark-display-string (bookmark display-string)
1342   "Set the display string of BOOKMARK to DISPLAY-STRING."
1343   (setcar bookmark display-string))
1344
1345 (defun elpher-bookmark-url (bookmark)
1346   "Get the address for BOOKMARK."
1347   (elt bookmark 1))
1348
1349 (defun elpher-save-bookmarks (bookmarks)
1350   "Record the bookmark list BOOKMARKS to the user's bookmark file.
1351 Beware that this completely replaces the existing contents of the file."
1352   (with-temp-file (locate-user-emacs-file "elpher-bookmarks")
1353     (erase-buffer)
1354     (insert "; Elpher bookmarks file\n\n"
1355             "; Bookmarks are stored as a list of (label URL) items.\n"
1356             "; Feel free to edit by hand, but take care to ensure\n"
1357             "; the list structure remains intact.\n\n")
1358     (pp bookmarks (current-buffer))))
1359
1360 (defun elpher-load-bookmarks ()
1361   "Get the list of bookmarks from the users's bookmark file."
1362   (let ((bookmarks
1363          (with-temp-buffer
1364            (ignore-errors
1365              (insert-file-contents (locate-user-emacs-file "elpher-bookmarks"))
1366              (goto-char (point-min))
1367              (read (current-buffer))))))
1368     (if (and bookmarks (listp (cadar bookmarks)))
1369         (progn
1370           (message "Reading old bookmark file. (Will be updated on write.)")
1371           (mapcar (lambda (old-bm)
1372                     (list (car old-bm)
1373                           (elpher-address-to-url (apply #'elpher-make-gopher-address
1374                                                         (cadr old-bm)))))
1375                   bookmarks))
1376       bookmarks)))
1377
1378 (defun elpher-add-address-bookmark (address display-string)
1379   "Save a bookmark for ADDRESS with label DISPLAY-STRING.)))
1380 If ADDRESS is already bookmarked, update the label only."
1381   (let ((bookmarks (elpher-load-bookmarks))
1382         (url (elpher-address-to-url address)))
1383     (let ((existing-bookmark (rassoc (list url) bookmarks)))
1384       (if existing-bookmark
1385           (elpher-set-bookmark-display-string existing-bookmark display-string)
1386         (push (elpher-make-bookmark display-string url) bookmarks)))
1387     (elpher-save-bookmarks bookmarks)))
1388
1389 (defun elpher-remove-address-bookmark (address)
1390   "Remove any bookmark to ADDRESS."
1391   (let ((url (elpher-address-to-url address)))
1392     (elpher-save-bookmarks
1393      (seq-filter (lambda (bookmark)
1394                    (not (equal (elpher-bookmark-url bookmark) url)))
1395                  (elpher-load-bookmarks)))))
1396
1397 ;;; Interactive procedures
1398 ;;
1399
1400 (defun elpher-next-link ()
1401   "Move point to the next link on the current page."
1402   (interactive)
1403   (forward-button 1))
1404
1405 (defun elpher-prev-link ()
1406   "Move point to the previous link on the current page."
1407   (interactive)
1408   (backward-button 1))
1409
1410 (defun elpher-follow-current-link ()
1411   "Open the link or url at point."
1412   (interactive)
1413   (push-button))
1414
1415 (defun elpher-go (host-or-url)
1416   "Go to a particular gopher site HOST-OR-URL.
1417 When run interactively HOST-OR-URL is read from the minibuffer."
1418   (interactive "sGopher or Gemini URL: ")
1419   (let ((page (elpher-make-page host-or-url
1420                                 (elpher-address-from-url host-or-url))))
1421     (switch-to-buffer "*elpher*")
1422     (elpher-visit-page page)
1423     '()))
1424
1425 (defun elpher-go-current ()
1426   "Go to a particular site read from the minibuffer, initialized with the current URL."
1427   (interactive)
1428   (let ((address (elpher-page-address elpher-current-page)))
1429     (if (elpher-address-special-p address)
1430         (error "Command invalid for this page")
1431       (let ((url (read-string "Gopher or Gemini URL: " (elpher-address-to-url address))))
1432         (elpher-visit-page (elpher-make-page url (elpher-address-from-url url)))))))
1433
1434 (defun elpher-redraw ()
1435   "Redraw current page."
1436   (interactive)
1437   (elpher-visit-page elpher-current-page))
1438
1439 (defun elpher-reload ()
1440   "Reload current page."
1441   (interactive)
1442   (elpher-reload-current-page))
1443
1444 (defun elpher-toggle-tls ()
1445   "Toggle TLS encryption mode for gopher."
1446   (interactive)
1447   (setq elpher-use-tls (not elpher-use-tls))
1448   (if elpher-use-tls
1449       (if (gnutls-available-p)
1450           (message "TLS gopher mode enabled.  (Will not affect current page until reload.)")
1451         (setq elpher-use-tls nil)
1452         (error "Cannot enable TLS gopher mode: GnuTLS not available"))
1453     (message "TLS gopher mode disabled.  (Will not affect current page until reload.)")))
1454
1455 (defun elpher-view-raw ()
1456   "View raw server response for current page."
1457   (interactive)
1458   (if (elpher-address-special-p (elpher-page-address elpher-current-page))
1459       (error "This page was not generated by a server")
1460     (elpher-visit-page elpher-current-page
1461                        #'elpher-render-raw)))
1462
1463 (defun elpher-back ()
1464   "Go to previous site."
1465   (interactive)
1466   (elpher-visit-previous-page))
1467
1468 (defun elpher-download ()
1469   "Download the link at point."
1470   (interactive)
1471   (let ((button (button-at (point))))
1472     (if button
1473         (let ((page (button-get button 'elpher-page)))
1474           (if (elpher-address-special-p (elpher-page-address page))
1475               (error "Cannot download %s"
1476                      (elpher-page-display-string page))
1477             (elpher-visit-page (button-get button 'elpher-page)
1478                                #'elpher-render-download)))
1479       (error "No link selected"))))
1480
1481 (defun elpher-download-current ()
1482   "Download the current page."
1483   (interactive)
1484   (if (elpher-address-special-p (elpher-page-address elpher-current-page))
1485       (error "Cannot download %s"
1486              (elpher-page-display-string elpher-current-page))
1487     (elpher-visit-page (elpher-make-page
1488                         (elpher-page-display-string elpher-current-page)
1489                         (elpher-page-address elpher-current-page))
1490                        #'elpher-render-download
1491                        t)))
1492
1493 (defun elpher-build-link-map ()
1494   "Build alist mapping link names to destination pages in current buffer."
1495   (let ((link-map nil)
1496         (b (next-button (point-min) t)))
1497     (while b
1498       (push (cons (button-label b) b) link-map)
1499       (setq b (next-button (button-start b))))
1500     link-map))
1501
1502 (defun elpher-jump ()
1503   "Select a directory entry by name.  Similar to the info browser (m)enu command."
1504   (interactive)
1505   (let* ((link-map (elpher-build-link-map)))
1506     (if link-map
1507         (let ((key (let ((completion-ignore-case t))
1508                      (completing-read "Directory item/link: "
1509                                       link-map nil t))))
1510           (if (and key (> (length key) 0))
1511               (let ((b (cdr (assoc key link-map))))
1512                 (goto-char (button-start b))
1513                 (button-activate b)))))))
1514
1515 (defun elpher-root-dir ()
1516   "Visit root of current server."
1517   (interactive)
1518   (let ((address (elpher-page-address elpher-current-page)))
1519     (if (not (elpher-address-special-p address))
1520         (if (or (member (url-filename address) '("/" ""))
1521                 (and (elpher-address-gopher-p address)
1522                      (= (length (elpher-gopher-address-selector address)) 0)))
1523             (error "Already at root directory of current server")
1524           (let ((address-copy (elpher-address-from-url
1525                                (elpher-address-to-url address))))
1526             (setf (url-filename address-copy) "")
1527             (elpher-go (elpher-address-to-url address-copy))))
1528       (error "Command invalid for %s" (elpher-page-display-string elpher-current-page)))))
1529
1530 (defun elpher-bookmarks-current-p ()
1531   "Return non-nil if current page is a bookmarks page."
1532   (equal (elpher-address-type (elpher-page-address elpher-current-page))
1533          '(special bookmarks)))
1534
1535 (defun elpher-reload-bookmarks ()
1536   "Reload bookmarks if current page is a bookmarks page."
1537   (if (elpher-bookmarks-current-p)
1538       (elpher-reload-current-page)))
1539
1540 (defun elpher-bookmark-current ()
1541   "Bookmark the current page."
1542   (interactive)
1543   (let ((address (elpher-page-address elpher-current-page))
1544         (display-string (elpher-page-display-string elpher-current-page)))
1545     (if (not (elpher-address-special-p address))
1546         (let ((bookmark-display-string (read-string "Bookmark display string: "
1547                                                     display-string)))
1548           (elpher-add-address-bookmark address bookmark-display-string)
1549           (message "Bookmark added."))
1550       (error "Cannot bookmark %s" display-string))))
1551
1552 (defun elpher-bookmark-link ()
1553   "Bookmark the link at point."
1554   (interactive)
1555   (let ((button (button-at (point))))
1556     (if button
1557         (let* ((page (button-get button 'elpher-page))
1558                (address (elpher-page-address page))
1559                (display-string (elpher-page-display-string page)))
1560           (if (not (elpher-address-special-p address))
1561               (let ((bookmark-display-string (read-string "Bookmark display string: "
1562                                                           display-string)))
1563                 (elpher-add-address-bookmark address bookmark-display-string)
1564                 (elpher-reload-bookmarks)
1565                 (message "Bookmark added."))
1566             (error "Cannot bookmark %s" display-string)))
1567       (error "No link selected"))))
1568
1569 (defun elpher-unbookmark-current ()
1570   "Remove bookmark for the current page."
1571   (interactive)
1572   (let ((address (elpher-page-address elpher-current-page)))
1573     (unless (elpher-address-special-p address)
1574       (elpher-remove-address-bookmark address)
1575       (message "Bookmark removed."))))
1576
1577 (defun elpher-unbookmark-link ()
1578   "Remove bookmark for the link at point."
1579   (interactive)
1580   (let ((button (button-at (point))))
1581     (if button
1582         (let ((page (button-get button 'elpher-page)))
1583           (elpher-remove-address-bookmark (elpher-page-address page))
1584           (elpher-reload-bookmarks)
1585           (message "Bookmark removed."))
1586       (error "No link selected"))))
1587
1588 (defun elpher-bookmarks ()
1589   "Visit bookmarks page."
1590   (interactive)
1591   (switch-to-buffer "*elpher*")
1592   (elpher-visit-page
1593    (elpher-make-page "Bookmarks Page" (elpher-make-special-address 'bookmarks))))
1594
1595 (defun elpher-info-page (page)
1596   "Display information on PAGE."
1597   (let ((display-string (elpher-page-display-string page))
1598         (address (elpher-page-address page)))
1599     (if (elpher-address-special-p address)
1600         (message "Special page: %s" display-string)
1601       (message "%s" (elpher-address-to-url address)))))
1602
1603 (defun elpher-info-link ()
1604   "Display information on page corresponding to link at point."
1605   (interactive)
1606   (let ((button (button-at (point))))
1607     (if button
1608         (elpher-info-page (button-get button 'elpher-page))
1609       (error "No item selected"))))
1610
1611 (defun elpher-info-current ()
1612   "Display information on current page."
1613   (interactive)
1614   (elpher-info-page elpher-current-page))
1615
1616 (defun elpher-copy-page-url (page)
1617   "Copy URL representation of address of PAGE to `kill-ring'."
1618   (let ((address (elpher-page-address page)))
1619     (if (elpher-address-special-p address)
1620         (error (format "Cannot represent %s as URL" (elpher-page-display-string page)))
1621       (let ((url (elpher-address-to-url address)))
1622         (message "Copied \"%s\" to kill-ring/clipboard." url)
1623         (kill-new url)))))
1624
1625 (defun elpher-copy-link-url ()
1626   "Copy URL of item at point to `kill-ring'."
1627   (interactive)
1628   (let ((button (button-at (point))))
1629     (if button
1630         (elpher-copy-page-url (button-get button 'elpher-page))
1631       (error "No item selected"))))
1632
1633 (defun elpher-copy-current-url ()
1634   "Copy URL of current page to `kill-ring'."
1635   (interactive)
1636   (elpher-copy-page-url elpher-current-page))
1637
1638 (defun elpher-set-gopher-coding-system ()
1639   "Specify an explicit character coding system for gopher selectors."
1640   (interactive)
1641   (let ((system (read-coding-system "Set coding system to use for gopher (default is to autodetect): " nil)))
1642     (setq elpher-user-coding-system system)
1643     (if system
1644         (message "Gopher coding system fixed to %s. (Reload to see effect)." system)
1645       (message "Gopher coding system set to autodetect. (Reload to see effect)."))))
1646
1647
1648 ;;; Mode and keymap
1649 ;;
1650
1651 (defvar elpher-mode-map
1652   (let ((map (make-sparse-keymap)))
1653     (define-key map (kbd "TAB") 'elpher-next-link)
1654     (define-key map (kbd "<backtab>") 'elpher-prev-link)
1655     (define-key map (kbd "u") 'elpher-back)
1656     (define-key map [mouse-3] 'elpher-back)
1657     (define-key map (kbd "O") 'elpher-root-dir)
1658     (define-key map (kbd "g") 'elpher-go)
1659     (define-key map (kbd "o") 'elpher-go-current)
1660     (define-key map (kbd "r") 'elpher-redraw)
1661     (define-key map (kbd "R") 'elpher-reload)
1662     (define-key map (kbd "T") 'elpher-toggle-tls)
1663     (define-key map (kbd ".") 'elpher-view-raw)
1664     (define-key map (kbd "d") 'elpher-download)
1665     (define-key map (kbd "D") 'elpher-download-current)
1666     (define-key map (kbd "m") 'elpher-jump)
1667     (define-key map (kbd "i") 'elpher-info-link)
1668     (define-key map (kbd "I") 'elpher-info-current)
1669     (define-key map (kbd "c") 'elpher-copy-link-url)
1670     (define-key map (kbd "C") 'elpher-copy-current-url)
1671     (define-key map (kbd "a") 'elpher-bookmark-link)
1672     (define-key map (kbd "A") 'elpher-bookmark-current)
1673     (define-key map (kbd "x") 'elpher-unbookmark-link)
1674     (define-key map (kbd "X") 'elpher-unbookmark-current)
1675     (define-key map (kbd "B") 'elpher-bookmarks)
1676     (define-key map (kbd "S") 'elpher-set-gopher-coding-system)
1677     (when (fboundp 'evil-define-key*)
1678       (evil-define-key* 'motion map
1679         (kbd "TAB") 'elpher-next-link
1680         (kbd "C-") 'elpher-follow-current-link
1681         (kbd "C-t") 'elpher-back
1682         (kbd "u") 'elpher-back
1683         [mouse-3] 'elpher-back
1684         (kbd "g") 'elpher-go
1685         (kbd "o") 'elpher-go-current
1686         (kbd "r") 'elpher-redraw
1687         (kbd "R") 'elpher-reload
1688         (kbd "T") 'elpher-toggle-tls
1689         (kbd ".") 'elpher-view-raw
1690         (kbd "d") 'elpher-download
1691         (kbd "D") 'elpher-download-current
1692         (kbd "m") 'elpher-jump
1693         (kbd "i") 'elpher-info-link
1694         (kbd "I") 'elpher-info-current
1695         (kbd "c") 'elpher-copy-link-url
1696         (kbd "C") 'elpher-copy-current-url
1697         (kbd "a") 'elpher-bookmark-link
1698         (kbd "A") 'elpher-bookmark-current
1699         (kbd "x") 'elpher-unbookmark-link
1700         (kbd "X") 'elpher-unbookmark-current
1701         (kbd "B") 'elpher-bookmarks
1702         (kbd "S") 'elpher-set-gopher-coding-system))
1703     map)
1704   "Keymap for gopher client.")
1705
1706 (define-derived-mode elpher-mode special-mode "elpher"
1707   "Major mode for elpher, an elisp gopher client.
1708
1709 This mode is automatically enabled by the interactive
1710 functions which initialize the gopher client, namely
1711 `elpher', `elpher-go' and `elpher-bookmarks'.")
1712
1713 (when (fboundp 'evil-set-initial-state)
1714   (evil-set-initial-state 'elpher-mode 'motion))
1715
1716
1717 ;;; Main start procedure
1718 ;;
1719
1720 ;;;###autoload
1721 (defun elpher ()
1722   "Start elpher with default landing page."
1723   (interactive)
1724   (if (get-buffer "*elpher*")
1725       (switch-to-buffer "*elpher*")
1726     (switch-to-buffer "*elpher*")
1727     (setq elpher-current-page nil)
1728     (let ((start-page (elpher-make-page "Elpher Start Page"
1729                                         (elpher-make-special-address 'start))))
1730       (elpher-visit-page start-page)))
1731   "Started Elpher.") ; Otherwise (elpher) evaluates to start page string.
1732
1733 ;;; elpher.el ends here