elpher.el

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