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