elpher.el

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