elpher.el

   1 ;;; elpher.el --- Full-featured gopher client.
   2
   3 ;; Copyright (C) 2019 Tim Vaughan
   4
   5 ;; Author: Tim Vaughan <tgvaughan@gmail.com>
   6 ;; Created: 11 April 2019
   7 ;; Version: 1.1.0
   8 ;; Keywords: comm gopher
   9 ;; Homepage: https://github.com/tgvaughan/elpher
  10 ;; Package-Requires: ((emacs "25"))
  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 full-featured gopher client for GNU Emacs.
  30 ;; It supports:
  31
  32 ;; - intuitive keyboard and mouse-driven interface,
  33 ;; - caching of visited sites (both content and cursor position),
  34 ;; - pleasant and configurable colouring of Gopher directories,
  35 ;; - direct visualisation of image files,
  36 ;; - (m)enu key support, similar to Emacs' info browser,
  37 ;; - clickable web and gopher links in plain text.
  38
  39 ;; Visited pages are stored as a hierarchy rather than a linear history,
  40 ;; meaning that navigation between these pages is quick and easy.
  41
  42 ;; To launch Elpher, simply use 'M-x elpher'.  This will open a start
  43 ;; page containing information on key bindings and suggested starting
  44 ;; points for your gopher exploration.
  45
  46 ;; Faces, caching options and start page can be configured via
  47 ;; the Elpher customization group in Applications.
  48
  49 ;;; Code:
  50
  51 (provide 'elpher)
  52 (require 'seq)
  53 (require 'pp)
  54
  55 ;;; Global constants
  56 ;;
  57
  58 (defconst elpher-version "1.1.0"
  59   "Current version of elpher.")
  60
  61 (defconst elpher-margin-width 6
  62   "Width of left-hand margin used when rendering indicies.")
  63
  64 (defconst elpher-start-index
  65   (mapconcat
  66    'identity
  67    (list "i\tfake\tfake\t1"
  68          "i     --------------------------------------------\tfake\tfake\t1"
  69          "i                Elpher Gopher Client             \tfake\tfake\t1"
  70          (format "i                   version %s\tfake\tfake\t1" elpher-version)
  71          "i     --------------------------------------------\tfake\tfake\t1"
  72          "i\tfake\tfake\t1"
  73          "iUsage:\tfake\tfake\t1"
  74          "i\tfake\tfake\t1"
  75          "i - tab/shift-tab: next/prev item on current page\tfake\tfake\t1"
  76          "i - RET/mouse-1: open item under cursor\tfake\tfake\t1"
  77          "i - m: select an item on current page by name (autocompletes)\tfake\tfake\t1"
  78          "i - u: return to parent\tfake\tfake\t1"
  79          "i - O: visit the root menu of the current server\tfake\tfake\t1"
  80          "i - g: go to a particular menu or item\tfake\tfake\t1"
  81          "i - i/I: info on item under cursor or current page\tfake\tfake\t1"
  82          "i - c/C: copy URL representation of item under cursor or current page\tfake\tfake\t1"
  83          "i - r: redraw current page (using cached contents if available)\tfake\tfake\t1"
  84          "i - R: reload current page (regenerates cache)\tfake\tfake\t1"
  85          "i - d: download directory entry under cursor\tfake\tfake\t1"
  86          "i - w: display the raw server response for the current page\tfake\tfake\t1"
  87          "i\tfake\tfake\t1"
  88          "iPlaces to start exploring Gopherspace:\tfake\tfake\t1"
  89          "i\tfake\tfake\t1"
  90          "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70"
  91          "i\tfake\tfake\t1"
  92          "iAlternatively, select the following item and enter some\tfake\tfake\t1"
  93          "isearch terms:\tfake\tfake\t1"
  94          "i\tfake\tfake\t1"
  95          "7Veronica-2 Gopher Search Engine\t/v2/vs\tgopher.floodgap.com\t70"
  96          ".\r\n")
  97    "\r\n")
  98   "Source for elpher start page.")
  99
 100 (defconst elpher-type-map
 101   '((?0 elpher-get-text-node "T" elpher-text)
 102     (?1 elpher-get-index-node "/" elpher-index)
 103     (?4 elpher-get-node-download "B" elpher-binary)
 104     (?5 elpher-get-node-download "B" elpher-binary)
 105     (?7 elpher-get-search-node "?" elpher-search)
 106     (?8 elpher-get-telnet-node "?" elpher-telnet)
 107     (?9 elpher-get-node-download "B" elpher-binary)
 108     (?g elpher-get-image-node "im" elpher-image)
 109     (?p elpher-get-image-node "im" elpher-image)
 110     (?I elpher-get-image-node "im" elpher-image)
 111     (?h elpher-get-url-node "W" elpher-url)
 112     (bookmarks elpher-get-bookmarks-node "#" elpher-index)
 113     (start elpher-get-start-node "#" elpher-index))
 114   "Association list from types to getters, margin codes and index faces.")
 115
 116
 117 ;;; Customization group
 118 ;;
 119
 120 (defgroup elpher nil
 121   "A gopher client."
 122   :group 'applications)
 123
 124 ;; Face customizations
 125
 126 (defface elpher-index
 127   '((t :inherit font-lock-keyword-face))
 128   "Face used for directory type directory records.")
 129
 130 (defface elpher-text
 131   '((t :inherit bold))
 132   "Face used for text type directory records.")
 133
 134 (defface elpher-info
 135   '((t :inherit default))
 136   "Face used for info type directory records.")
 137
 138 (defface elpher-image
 139   '((t :inherit font-lock-string-face))
 140   "Face used for image type directory records.")
 141
 142 (defface elpher-search
 143   '((t :inherit warning))
 144   "Face used for search type directory records.")
 145
 146 (defface elpher-url
 147   '((t :inherit font-lock-comment-face))
 148   "Face used for url type directory records.")
 149
 150 (defface elpher-telnet
 151   '((t :inherit font-lock-function-name-face))
 152   "Face used for telnet type directory records.")
 153
 154 (defface elpher-binary
 155   '((t :inherit font-lock-doc-face))
 156   "Face used for binary type directory records.")
 157
 158 (defface elpher-unknown
 159   '((t :inherit error))
 160   "Face used for directory records with unknown/unsupported types.")
 161
 162 (defface elpher-margin-key
 163   '((t :inherit bold))
 164   "Face used for directory margin key.")
 165
 166 (defface elpher-margin-brackets
 167   '((t :inherit shadow))
 168   "Face used for brackets around directory margin key.")
 169
 170 ;; Other customizations
 171
 172 (defcustom elpher-open-urls-with-eww nil
 173   "If non-nil, open URL selectors using eww.
 174 Otherwise, use the system browser via the BROWSE-URL function."
 175   :type '(boolean))
 176
 177 (defcustom elpher-buttonify-urls-in-directories nil
 178   "If non-nil, turns URLs matched in directories into clickable buttons."
 179   :type '(boolean))
 180
 181 (defcustom elpher-cache-images nil
 182   "If non-nil, cache images in memory in the same way as other content."
 183   :type '(boolean))
 184
 185 (defcustom elpher-start-address nil
 186   "If nil, the default start directory is shown when Elpher is started.
 187 Otherwise, a list containing the selector, host and port of a directory to
 188 use as the start page."
 189   :type '(list string string integer))
 190
 191 (defcustom elpher-use-header t
 192   "If non-nil, display current node information in buffer header."
 193   :type '(boolean))
 194
 195 ;;; Model
 196 ;;
 197
 198 ;; Address
 199
 200 (defun elpher-make-address (type &optional selector host port)
 201   "Create an address of a gopher object with TYPE, SELECTOR, HOST and PORT.
 202 Although selector host and port are optional, they are only omitted for
 203 special address types, such as 'start for the start page."
 204   (list type selector host port))
 205
 206 (defun elpher-address-type (address)
 207   "Retrieve type from ADDRESS."
 208   (elt address 0))
 209
 210 (defun elpher-address-selector (address)
 211   "Retrieve selector from ADDRESS."
 212   (elt address 1))
 213
 214 (defun elpher-address-host (address)
 215   "Retrieve host from ADDRESS."
 216   (elt address 2))
 217
 218 (defun elpher-address-port (address)
 219   "Retrieve port from ADDRESS."
 220   (elt address 3))
 221
 222 ;; Node
 223
 224 (defun elpher-make-node (display-string parent address &optional content pos)
 225   "Create a node in the gopher page hierarchy.
 226
 227 DISPLAY-STRING records the display string used for the page.
 228
 229 PARENT specifies the parent of the node, and ADDRESS specifies the
 230 address of the gopher page.
 231
 232 The optional arguments CONTENT and POS can be used to fill the cached
 233 content and cursor position fields of the node."
 234   (list display-string parent address content pos))
 235
 236 (defun elpher-node-display-string (node)
 237   "Retrieve the display string of NODE."
 238   (elt node 0))
 239
 240 (defun elpher-node-parent (node)
 241   "Retrieve the parent node of NODE."
 242   (elt node 1))
 243
 244 (defun elpher-node-address (node)
 245   "Retrieve the address of NODE."
 246   (elt node 2))
 247
 248 (defun elpher-node-content (node)
 249   "Retrieve the cached content of NODE, or nil if none exists."
 250   (elt node 3))
 251
 252 (defun elpher-node-pos (node)
 253   "Retrieve the cached cursor position for NODE, or nil if none exists."
 254   (elt node 4))
 255
 256 (defun elpher-set-node-content (node content)
 257   "Set the content cache of NODE to CONTENT."
 258   (setcar (nthcdr 3 node) content))
 259
 260 (defun elpher-set-node-pos (node pos)
 261   "Set the cursor position cache of NODE to POS."
 262   (setcar (nthcdr 4 node) pos))
 263
 264 ;; Node graph traversal
 265
 266 (defvar elpher-current-node nil)
 267
 268 (defun elpher-visit-node (node &optional getter)
 269   "Visit NODE using its own getter or GETTER, if non-nil."
 270   (elpher-save-pos)
 271   (elpher-process-cleanup)
 272   (setq elpher-current-node node)
 273   (if getter
 274       (funcall getter)
 275     (let* ((address (elpher-node-address node))
 276            (type (elpher-address-type address)))
 277       (funcall (car (alist-get type elpher-type-map))))))
 278
 279 (defun elpher-visit-parent-node ()
 280   "Visit the parent of the current node."
 281   (let ((parent-node (elpher-node-parent elpher-current-node)))
 282     (when parent-node
 283       (elpher-visit-node parent-node))))
 284
 285 (defun elpher-reload-current-node ()
 286   "Reload the current node, discarding any existing cached content."
 287   (elpher-set-node-content elpher-current-node nil)
 288   (elpher-visit-node elpher-current-node))
 289
 290 (defun elpher-save-pos ()
 291   "Save the current position of point to the current node."
 292   (when elpher-current-node
 293     (elpher-set-node-pos elpher-current-node (point))))
 294
 295 (defun elpher-restore-pos ()
 296   "Restore the position of point to that cached in the current node."
 297   (let ((pos (elpher-node-pos elpher-current-node)))
 298     (if pos
 299         (goto-char pos)
 300       (goto-char (point-min)))))
 301
 302
 303 ;;; Buffer preparation
 304 ;;
 305
 306 (defun elpher-update-header ()
 307   "If `elpher-use-header' is true, display current node info in window header."
 308   (if elpher-use-header
 309       (setq header-line-format (elpher-node-display-string elpher-current-node))))
 310
 311 (defmacro elpher-with-clean-buffer (&rest args)
 312   "Evaluate ARGS with a clean *elpher* buffer as current."
 313   (list 'with-current-buffer "*elpher*"
 314         '(elpher-mode)
 315         (append (list 'let '((inhibit-read-only t))
 316                       '(erase-buffer)
 317                       '(elpher-update-header))
 318                 args)))
 319
 320
 321 ;;; Index rendering
 322 ;;
 323
 324 (defun elpher-preprocess-text-response (string)
 325   "Clear away CRs and terminating period from STRING."
 326   (replace-regexp-in-string "\n\.\n$" "\n"
 327                             (replace-regexp-in-string "\r" ""
 328                                                       string)))
 329
 330 (defun elpher-insert-index (string)
 331   "Insert the index corresponding to STRING into the current buffer."
 332   ;; Should be able to split directly on CRLF, but some non-conformant
 333   ;; LF-only servers sadly exist, hence the following.
 334   (let ((str-processed (elpher-preprocess-text-response string)))
 335     (dolist (line (split-string str-processed "\n"))
 336       (unless (= (length line) 0)
 337         (let* ((type (elt line 0))
 338                (fields (split-string (substring line 1) "\t"))
 339                (display-string (elt fields 0))
 340                (selector (elt fields 1))
 341                (host (elt fields 2))
 342                (port (if (elt fields 3)
 343                          (string-to-number (elt fields 3))
 344                        nil)))
 345           (elpher-insert-index-record display-string type selector host port))))))
 346
 347 (defun elpher-insert-margin (&optional type-name)
 348   "Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
 349   (if type-name
 350       (progn
 351         (insert (format (concat "%" (number-to-string (- elpher-margin-width 1)) "s")
 352                         (concat
 353                          (propertize "[" 'face 'elpher-margin-brackets)
 354                          (propertize type-name 'face 'elpher-margin-key)
 355                          (propertize "]" 'face 'elpher-margin-brackets))))
 356         (insert " "))
 357     (insert (make-string elpher-margin-width ?\s))))
 358
 359 (defun elpher-node-button-help (node)
 360   "Return a string containing the help text for a button corresponding to NODE."
 361   (let ((address (elpher-node-address node)))
 362     (if (eq (elpher-address-type address) ?h)
 363         (let ((url (cadr (split-string (elpher-address-selector address) "URL:"))))
 364           (format "mouse-1, RET: open url '%s'" url))
 365       (format "mouse-1, RET: open '%s' on %s port %s"
 366               (elpher-address-selector address)
 367               (elpher-address-host address)
 368               (elpher-address-port address)))))
 369
 370 (defun elpher-insert-index-record (display-string type selector host port)
 371   "Function to insert an index record into the current buffer.
 372 The contents of the record are dictated by TYPE, DISPLAY-STRING, SELECTOR, HOST
 373 and PORT."
 374   (let ((address (elpher-make-address type selector host port))
 375         (type-map-entry (alist-get type elpher-type-map)))
 376     (if type-map-entry
 377         (let* ((margin-code (cadr type-map-entry))
 378                (face (caddr type-map-entry))
 379                (node (elpher-make-node display-string elpher-current-node address)))
 380           (elpher-insert-margin margin-code)
 381           (insert-text-button display-string
 382                               'face face
 383                               'elpher-node node
 384                               'action #'elpher-click-link
 385                               'follow-link t
 386                               'help-echo (elpher-node-button-help node)))
 387       (pcase type
 388         (?i ;; Information
 389          (elpher-insert-margin)
 390          (insert (propertize
 391                   (if elpher-buttonify-urls-in-directories
 392                       (elpher-buttonify-urls display-string)
 393                     display-string)
 394                   'face 'elpher-info)))
 395         (other ;; Unknown
 396          (elpher-insert-margin (concat (char-to-string type) "?"))
 397          (insert (propertize display-string
 398                              'face 'elpher-unknown-face)))))
 399     (insert "\n")))
 400
 401 (defun elpher-click-link (button)
 402   "Function called when the gopher link BUTTON is activated (via mouse or keypress)."
 403   (let ((node (button-get button 'elpher-node)))
 404     (elpher-visit-node node)))
 405
 406
 407 ;;; Selector retrieval (all kinds)
 408 ;;
 409
 410 (defun elpher-process-cleanup ()
 411   "Immediately shut down any extant elpher process."
 412   (let ((p (get-process "elpher-process")))
 413     (if p (delete-process p))))
 414
 415 (defvar elpher-selector-string)
 416
 417 (defun elpher-get-selector (address after)
 418   "Retrieve selector specified by ADDRESS, then execute AFTER.
 419 The result is stored as a string in the variable ‘elpher-selector-string’."
 420   (setq elpher-selector-string "")
 421   (make-network-process
 422    :name "elpher-process"
 423    :host (elpher-address-host address)
 424    :service (elpher-address-port address)
 425    :filter (lambda (proc string)
 426              (setq elpher-selector-string (concat elpher-selector-string string)))
 427    :sentinel after)
 428   (process-send-string "elpher-process"
 429                        (concat (elpher-address-selector address) "\n")))
 430
 431 ;; Index retrieval
 432
 433 (defun elpher-get-index-node ()
 434   "Getter which retrieves the current node contents as an index."
 435   (let ((content (elpher-node-content elpher-current-node))
 436         (address (elpher-node-address elpher-current-node)))
 437     (if content
 438         (progn
 439           (elpher-with-clean-buffer
 440            (insert content)
 441            (elpher-restore-pos)))
 442       (elpher-with-clean-buffer
 443        (insert "LOADING DIRECTORY..."))
 444       (elpher-get-selector address
 445                            (lambda (proc event)
 446                              (unless (string-prefix-p "deleted" event)
 447                                (elpher-with-clean-buffer
 448                                 (elpher-insert-index elpher-selector-string)
 449                                 (elpher-restore-pos)
 450                                 (elpher-set-node-content elpher-current-node
 451                                                          (buffer-string)))))))))
 452
 453 ;; Text retrieval
 454
 455 (defconst elpher-url-regex
 456   "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?"
 457   "Regexp used to locate and buttinofy URLs in text files loaded by elpher.")
 458
 459 (defun elpher-make-node-from-matched-url (parent &optional string)
 460   "Convert most recent `elpher-url-regex' match to a node.
 461
 462 PARENT defines the node to set as the parent to the new node.
 463
 464 If STRING is non-nil, this is given as an argument to all `match-string'
 465 calls, as is necessary if the match is performed by `string-match'."
 466   (let ((url (match-string 0 string))
 467         (protocol (downcase (match-string 1 string))))
 468     (if (string= protocol "gopher")
 469         (let* ((host (match-string 2 string))
 470                (port (if (> (length (match-string 3 string))  1)
 471                          (string-to-number (substring (match-string 3 string) 1))
 472                        70))
 473                (type-and-selector (match-string 4 string))
 474                (type (if (> (length type-and-selector) 1)
 475                          (elt type-and-selector 1)
 476                        ?1))
 477                (selector (if (> (length type-and-selector) 1)
 478                              (substring type-and-selector 2)
 479                            ""))
 480                (address (elpher-make-address type selector host port)))
 481           (elpher-make-node url elpher-current-node address))
 482       (let* ((host (match-string 2 string))
 483              (port (if (> (length (match-string 3 string)) 1)
 484                        (string-to-number (substring (match-string 3 string) 1))
 485                      70))
 486              (selector (concat "URL:" url))
 487              (address (elpher-make-address ?h selector host port)))
 488         (elpher-make-node url elpher-current-node address)))))
 489
 490
 491 (defun elpher-buttonify-urls (string)
 492   "Turn substrings which look like urls in STRING into clickable buttons."
 493   (with-temp-buffer
 494     (insert string)
 495     (goto-char (point-min))
 496     (while (re-search-forward elpher-url-regex nil t)
 497         (let ((node (elpher-make-node-from-matched-url elpher-current-node)))
 498           (make-text-button (match-beginning 0)
 499                             (match-end 0)
 500                             'elpher-node  node
 501                             'action #'elpher-click-link
 502                             'follow-link t
 503                             'help-echo (elpher-node-button-help node))))
 504     (buffer-string)))
 505
 506 (defun elpher-get-text-node ()
 507   "Getter which retrieves the current node contents as a text document."
 508   (let ((content (elpher-node-content elpher-current-node))
 509         (address (elpher-node-address elpher-current-node)))
 510     (if content
 511         (progn
 512           (elpher-with-clean-buffer
 513            (insert content)
 514            (elpher-restore-pos)))
 515       (progn
 516         (elpher-with-clean-buffer
 517          (insert "LOADING TEXT..."))
 518         (elpher-get-selector address
 519                               (lambda (proc event)
 520                                 (unless (string-prefix-p "deleted" event)
 521                                   (elpher-with-clean-buffer
 522                                    (insert (elpher-buttonify-urls
 523                                             (elpher-preprocess-text-response
 524                                              elpher-selector-string)))
 525                                    (elpher-restore-pos)
 526                                    (elpher-set-node-content elpher-current-node
 527                                                             (buffer-string))))))))))
 528
 529 ;; Image retrieval
 530
 531 (defun elpher-get-image-node ()
 532   "Getter which retrieves the current node contents as an image to view."
 533   (let ((content (elpher-node-content elpher-current-node))
 534         (address (elpher-node-address elpher-current-node)))
 535     (if content
 536         (progn
 537           (elpher-with-clean-buffer
 538            (insert-image content)
 539            (elpher-restore-pos)))
 540       (if (display-images-p)
 541           (progn
 542             (elpher-with-clean-buffer
 543              (insert "LOADING IMAGE..."))
 544             (elpher-get-selector address
 545                                  (lambda (proc event)
 546                                    (unless (string-prefix-p "deleted" event)
 547                                      (let ((image (create-image
 548                                                    (encode-coding-string
 549                                                     elpher-selector-string
 550                                                     'no-conversion)
 551                                                    nil t)))
 552                                        (elpher-with-clean-buffer
 553                                         (insert-image image)
 554                                         (elpher-restore-pos))
 555                                        (if elpher-cache-images
 556                                            (elpher-set-node-content elpher-current-node
 557                                                                     image)))))))
 558         (elpher-get-node-download)))))
 559
 560 ;; Search retrieval
 561
 562 (defun elpher-get-search-node ()
 563   "Getter which submits a search query to the address of the current node."
 564   (let ((content (elpher-node-content elpher-current-node))
 565         (address (elpher-node-address elpher-current-node))
 566         (aborted t))
 567     (if content
 568         (progn
 569           (elpher-with-clean-buffer
 570            (insert content)
 571            (elpher-restore-pos))
 572           (message "Displaying cached search results.  Reload to perform a new search."))
 573       (unwind-protect
 574           (let* ((query-string (read-string "Query: "))
 575                  (query-selector (concat (elpher-address-selector address) "\t" query-string))
 576                  (search-address (elpher-make-address ?1
 577                                                       query-selector
 578                                                       (elpher-address-host address)
 579                                                       (elpher-address-port address))))
 580             (setq aborted nil)
 581             (elpher-with-clean-buffer
 582              (insert "LOADING RESULTS..."))
 583             (elpher-get-selector search-address
 584                                   (lambda (proc event)
 585                                     (unless (string-prefix-p "deleted" event)
 586                                       (elpher-with-clean-buffer
 587                                        (elpher-insert-index elpher-selector-string))
 588                                       (goto-char (point-min))
 589                                       (elpher-set-node-content elpher-current-node
 590                                                                 (buffer-string))))))
 591         (if aborted
 592             (elpher-visit-parent-node))))))
 593
 594 ;; Raw server response retrieval
 595
 596 (defun elpher-get-node-raw ()
 597   "Getter which retrieves the raw server response for the current node."
 598   (let* ((content (elpher-node-content elpher-current-node))
 599          (address (elpher-node-address elpher-current-node)))
 600     (elpher-with-clean-buffer
 601      (insert "LOADING RAW SERVER RESPONSE..."))
 602     (if address
 603         (elpher-get-selector address
 604                               (lambda (proc event)
 605                                 (unless (string-prefix-p "deleted" event)
 606                                   (elpher-with-clean-buffer
 607                                    (insert elpher-selector-string)
 608                                    (goto-char (point-min))))))
 609       (progn
 610         (elpher-with-clean-buffer
 611          (insert elpher-start-index))
 612         (goto-char (point-min)))))
 613   (message "Displaying raw server response.  Reload or redraw to return to standard view."))
 614
 615 ;; File export retrieval
 616
 617 (defvar elpher-download-filename)
 618
 619 (defun elpher-get-node-download ()
 620   "Getter which retrieves the current node and writes the result to a file."
 621   (let* ((address (elpher-node-address elpher-current-node))
 622          (selector (elpher-address-selector address)))
 623     (elpher-visit-parent-node) ; Do first in case of non-local exits.
 624     (let* ((filename-proposal (file-name-nondirectory selector))
 625            (filename (read-file-name "Save file as: "
 626                                      nil nil nil
 627                                      (if (> (length filename-proposal) 0)
 628                                          filename-proposal
 629                                        "gopher.file"))))
 630       (message "Downloading...")
 631       (setq elpher-download-filename filename)
 632       (elpher-get-selector address
 633                             (lambda (proc event)
 634                               (let ((coding-system-for-write 'binary))
 635                                 (with-temp-file elpher-download-filename
 636                                   (insert elpher-selector-string)
 637                                   (message (format "Download complate, saved to file %s."
 638                                                    elpher-download-filename)))))))))
 639
 640 ;; URL retrieval
 641
 642 (defun elpher-get-url-node ()
 643   "Getter which attempts to open the URL specified by the current node."
 644   (let* ((address (elpher-node-address elpher-current-node))
 645          (selector (elpher-address-selector address)))
 646     (elpher-visit-parent-node) ; Do first in case of non-local exits.
 647     (let ((url (elt (split-string selector "URL:") 1)))
 648       (if elpher-open-urls-with-eww
 649           (browse-web url)
 650         (browse-url url)))))
 651
 652 ;; Telnet node connection
 653
 654 (defun elpher-get-telnet-node ()
 655   "Getter which opens a telnet connection to the server specified by the current node."
 656   (let* ((address (elpher-node-address elpher-current-node))
 657          (host (elpher-address-host address))
 658          (port (elpher-address-port address)))
 659     (elpher-visit-parent-node)
 660     (telnet host port)))
 661
 662 ;; Start node retrieval
 663
 664 (defun elpher-get-start-node ()
 665   "Getter which displays the start page."
 666   (elpher-with-clean-buffer
 667    (elpher-insert-index elpher-start-index)
 668    (elpher-restore-pos)))
 669
 670
 671 ;;; Bookmarks
 672 ;;
 673
 674 (defun elpher-make-bookmark (display-string address)
 675   "Make an elpher bookmark.
 676 DISPLAY-STRING determines how the bookmark will appear in the
 677 bookmark list, while ADDRESS is the address of the entry."
 678   (list display-string address))
 679
 680 (defun elpher-bookmark-display-string (bookmark)
 681   "Get the display string of BOOKMARK."
 682   (elt bookmark 0))
 683
 684 (defun elpher-bookmark-address (bookmark)
 685   "Get the address for BOOKMARK."
 686   (elt bookmark 1))
 687
 688 (defun elpher-save-bookmarks (bookmarks)
 689   "Record the bookmark list BOOKMARKS to the user's bookmark file.
 690 Beware that this completely replaces the existing contents of the file."
 691   (with-temp-file (locate-user-emacs-file "elpher-bookmarks")
 692     (erase-buffer)
 693     (pp bookmarks (current-buffer))))
 694
 695 (defun elpher-load-bookmarks ()
 696   "Get the list of bookmarks from the users's bookmark file."
 697   (with-temp-buffer
 698     (ignore-errors
 699       (insert-file-contents (locate-user-emacs-file "elpher-bookmarks"))
 700       (goto-char (point-min))
 701       (read (current-buffer)))))
 702
 703 (defun elpher-add-node-bookmark (node)
 704   "Add bookmark to NODE to the saved list of bookmarks."
 705   (let ((bookmark (elpher-make-bookmark (elpher-node-display-string node)
 706                                         (elpher-node-address node)))
 707         (bookmarks (elpher-load-bookmarks)))
 708     (add-to-list 'bookmarks bookmark)
 709     (elpher-save-bookmarks bookmarks)))
 710
 711 (defun elpher-remove-node-bookmark (node)
 712   "Remove bookmark to NODE from the saved list of bookmarks."
 713   (let ((bookmark (elpher-make-bookmark (elpher-node-display-string node)
 714                                         (elpher-node-address node))))
 715     (elpher-save-bookmarks
 716      (seq-filter (lambda (this-bookmark)
 717                    (not (equal bookmark this-bookmark)))
 718                  (elpher-load-bookmarks)))))
 719
 720 (defun elpher-display-bookmarks ()
 721   "Display saved bookmark list."
 722   (interactive)
 723   (elpher-with-clean-buffer
 724    (insert "Use 'r' to return to the previous page.\n\n"
 725            "---- Bookmark list ----\n\n")
 726    (let ((bookmarks (elpher-load-bookmarks)))
 727      (if bookmarks
 728          (dolist (bookmark bookmarks)
 729            (let ((display-string (elpher-bookmark-display-string bookmark))
 730                  (address (elpher-bookmark-address bookmark)))
 731              (elpher-insert-index-record display-string
 732                                          (elpher-address-type address)
 733                                          (elpher-address-selector address)
 734                                          (elpher-address-host address)
 735                                          (elpher-address-port address))))
 736        (insert "No bookmarks found.\n")))
 737    (insert "\n-----------------------")
 738    (goto-char (point-min))
 739    (elpher-next-link)))
 740
 741 (defun elpher-bookmark-current ()
 742   "Bookmark the current node."
 743   (interactive)
 744   (elpher-add-node-bookmark elpher-current-node))
 745
 746 (defun elpher-bookmark-link ()
 747   "Bookmark the link at point."
 748   (interactive)
 749   (let ((button (button-at (point))))
 750     (if button
 751         (elpher-add-node-bookmark (button-get button 'elpher-node))
 752       (error "No link selected"))))
 753
 754 (defun elpher-unbookmark-current ()
 755   "Remove bookmark for the current node."
 756   (interactive)
 757   (elpher-remove-node-bookmark elpher-current-node))
 758
 759 (defun elpher-unbookmark-link ()
 760   "Remove bookmark for the link at point."
 761   (interactive)
 762   (let ((button (button-at (point))))
 763     (if button
 764         (elpher-remove-node-bookmark (button-get button 'elpher-node))
 765       (error "No link selected"))))
 766
 767 ;;; Interactive navigation procedures
 768 ;;
 769
 770 (defun elpher-next-link ()
 771   "Move point to the next link on the current page."
 772   (interactive)
 773   (forward-button 1))
 774
 775 (defun elpher-prev-link ()
 776   "Move point to the previous link on the current page."
 777   (interactive)
 778   (backward-button 1))
 779
 780 (defun elpher-follow-current-link ()
 781   "Open the link or url at point."
 782   (interactive)
 783   (push-button))
 784
 785 (defun elpher-go ()
 786   "Go to a particular gopher site."
 787   (interactive)
 788   (let ((node
 789          (let ((host-or-url (read-string "Gopher host or URL: ")))
 790            (if (string-match elpher-url-regex host-or-url)
 791                (elpher-make-node-from-matched-url elpher-current-node
 792                                                   host-or-url)
 793              (let ((selector (read-string "Selector (default none): " nil nil ""))
 794                    (port-string (read-string "Port (default 70): " nil nil "70")))
 795                (elpher-make-node (concat "gopher://" host-or-url
 796                                          ":" port-string
 797                                          "/1" selector)
 798                                  elpher-current-node
 799                                  (elpher-make-address ?1 selector host-or-url
 800                                                       (string-to-number port-string))))))))
 801     (switch-to-buffer "*elpher*")
 802     (elpher-visit-node node)))
 803
 804 (defun  elpher-redraw ()
 805   "Redraw current page."
 806   (interactive)
 807   (if elpher-current-node
 808       (elpher-visit-node elpher-current-node)
 809     (message "No current site.")))
 810
 811 (defun  elpher-reload ()
 812   "Reload current page."
 813   (interactive)
 814   (if elpher-current-node
 815       (elpher-reload-current-node)
 816     (message "No current site.")))
 817
 818 (defun elpher-view-raw ()
 819   "View current page as plain text."
 820   (interactive)
 821   (if elpher-current-node
 822       (elpher-visit-node elpher-current-node
 823                          #'elpher-get-node-raw)
 824     (message "No current site.")))
 825
 826 (defun elpher-back ()
 827   "Go to previous site."
 828   (interactive)
 829   (if (elpher-node-parent elpher-current-node)
 830       (elpher-visit-parent-node)
 831     (error "No previous site")))
 832
 833 (defun elpher-download ()
 834   "Download the link at point."
 835   (interactive)
 836   (let ((button (button-at (point))))
 837     (if button
 838         (let ((node (button-get button 'elpher-node)))
 839           (if node
 840               (elpher-visit-node (button-get button 'elpher-node)
 841                                  #'elpher-get-node-download)
 842             (error "Can only download gopher links, not general URLs")))
 843       (error "No link selected"))))
 844
 845 (defun elpher-build-link-map ()
 846   "Build alist mapping link names to destination nodes in current buffer."
 847   (let ((link-map nil)
 848         (b (next-button (point-min) t)))
 849     (while b
 850       (add-to-list 'link-map (cons (button-label b) b))
 851       (setq b (next-button (button-start b))))
 852     link-map))
 853
 854 (defun elpher-jump ()
 855   "Select a directory entry by name.  Similar to the info browser (m)enu command."
 856   (interactive)
 857   (let* ((link-map (elpher-build-link-map)))
 858     (if link-map
 859         (let ((key (let ((completion-ignore-case t))
 860                      (completing-read "Directory entry/link (tab to autocomplete): "
 861                                       link-map nil t))))
 862           (if (and key (> (length key) 0))
 863               (let ((b (cdr (assoc key link-map))))
 864                 (goto-char (button-start b))
 865                 (button-activate b)))))))
 866
 867 (defun elpher-root-dir ()
 868   "Visit root of current server."
 869   (interactive)
 870   (let* ((address (elpher-node-address elpher-current-node))
 871          (host (elpher-address-host address)))
 872     (if host
 873         (let ((host (elpher-address-host address))
 874               (selector (elpher-address-selector address))
 875               (port (elpher-address-port address)))
 876           (if (> (length selector) 0)
 877               (let ((root-address (elpher-make-address ?1 "" host port)))
 878                 (elpher-visit-node
 879                  (elpher-make-node (concat "gopher://" host
 880                                            ":" (number-to-string port)
 881                                            "/1/")
 882                                    elpher-current-node
 883                                    root-address)))
 884             (error "Already at root directory of current server")))
 885       (error "Command invalid for this page"))))
 886
 887 (defun elpher-info-node (node)
 888   "Display information on NODE."
 889   (let ((display-string (elpher-node-display-string node))
 890         (address (elpher-node-address node)))
 891     (if address
 892         (message "`%s' on %s port %s"
 893                 (elpher-address-selector address)
 894                 (elpher-address-host address)
 895                 (elpher-address-port address))
 896       (message "%s" display-string))))
 897
 898 (defun elpher-info-link ()
 899   "Display information on node corresponding to link at point."
 900   (interactive)
 901   (let ((button (button-at (point))))
 902     (if button
 903         (elpher-info-node (button-get button 'elpher-node))
 904       (error "No item selected"))))
 905
 906 (defun elpher-info-current ()
 907   "Display information on current node."
 908   (interactive)
 909   (elpher-info-node elpher-current-node))
 910
 911 (defun elpher-get-address-url (address)
 912   "Get URL representation of ADDRESS."
 913   (concat "gopher://"
 914           (elpher-address-host address)
 915           (let ((port (elpher-address-port address)))
 916             (if (equal port 70)
 917                 ""
 918               (format ":%d" port)))
 919           "/" (string (elpher-address-type address))
 920           (elpher-address-selector address)))
 921
 922 (defun elpher-copy-node-url (node)
 923   "Copy URL representation of address of NODE to `kill-ring'."
 924   (let ((address (elpher-node-address node)))
 925     (if address
 926         (let ((url (elpher-get-address-url address)))
 927           (message url)
 928           (kill-new url))
 929       (error (format "Cannot represent %s as URL" (elpher-node-display-string node))))))
 930
 931 (defun elpher-copy-link-url ()
 932   "Copy URL of item at point to `kill-ring'."
 933   (interactive)
 934   (let ((button (button-at (point))))
 935     (if button
 936         (elpher-copy-node-url (button-get button 'elpher-node))
 937       (error "No item selected"))))
 938
 939 (defun elpher-copy-current-url ()
 940   "Copy URL of current node to `kill-ring'."
 941   (interactive)
 942   (elpher-copy-node-url elpher-current-node))
 943
 944 ;;; Mode and keymap
 945 ;;
 946
 947 (defvar elpher-mode-map
 948   (let ((map (make-sparse-keymap)))
 949     (define-key map (kbd "TAB") 'elpher-next-link)
 950     (define-key map (kbd "<backtab>") 'elpher-prev-link)
 951     (define-key map (kbd "u") 'elpher-back)
 952     (define-key map (kbd "O") 'elpher-root-dir)
 953     (define-key map (kbd "g") 'elpher-go)
 954     (define-key map (kbd "r") 'elpher-redraw)
 955     (define-key map (kbd "R") 'elpher-reload)
 956     (define-key map (kbd "w") 'elpher-view-raw)
 957     (define-key map (kbd "d") 'elpher-download)
 958     (define-key map (kbd "m") 'elpher-jump)
 959     (define-key map (kbd "i") 'elpher-info-link)
 960     (define-key map (kbd "I") 'elpher-info-current)
 961     (define-key map (kbd "c") 'elpher-copy-link-url)
 962     (define-key map (kbd "C") 'elpher-copy-current-url)
 963     (when (fboundp 'evil-define-key)
 964       (evil-define-key 'motion map
 965         (kbd "TAB") 'elpher-next-link
 966         (kbd "C-]") 'elpher-follow-current-link
 967         (kbd "C-t") 'elpher-back
 968         (kbd "u") 'elpher-back
 969         (kbd "O") 'elpher-root-dir
 970         (kbd "g") 'elpher-go
 971         (kbd "r") 'elpher-redraw
 972         (kbd "R") 'elpher-reload
 973         (kbd "w") 'elpher-view-raw
 974         (kbd "d") 'elpher-download
 975         (kbd "m") 'elpher-jump
 976         (kbd "i") 'elpher-info-link
 977         (kbd "I") 'elpher-info-current
 978         (kbd "c") 'elpher-copy-link-url
 979         (kbd "C") 'elpher-copy-current-url
 980         (kbd "a") 'elpher-bookmark-link
 981         (kbd "A") 'elpher-bookmark-current
 982         (kbd "x") 'elpher-unbookmark-link
 983         (kbd "X") 'elpher-unbookmark-current
 984         (kbd "B") 'elpher-display-bookmarks))
 985     map)
 986   "Keymap for gopher client.")
 987
 988 (define-derived-mode elpher-mode special-mode "elpher"
 989   "Major mode for elpher, an elisp gopher client.")
 990
 991 (when (fboundp 'evil-set-initial-state)
 992   (evil-set-initial-state 'elpher-mode 'motion))
 993
 994 ;;; Main start procedure
 995 ;;
 996
 997 ;;;###autoload
 998 (defun elpher ()
 999   "Start elpher with default landing page."
1000   (interactive)
1001   (if (get-buffer "*elpher*")
1002       (switch-to-buffer "*elpher*")
1003     (switch-to-buffer "*elpher*")
1004     (setq elpher-current-node nil)
1005     (let ((start-node (elpher-make-node "Elpher Start Page" nil (elpher-make-address 'start))))
1006       (elpher-visit-node start-node)))
1007   "Started Elpher.") ; Otherwise (elpher) evaluates to start page string.
1008
1009 ;;; elpher.el ends here