elopher.el

   1 ;;; elopher.el --- elisp gopher client
   2
   3 ;;; Commentary:
   4
   5 ;; An elisp gopher client.
   6
   7 ;;; Code:
   8
   9 ;;; Global constants
  10 ;;
  11
  12 (defconst elopher-version "1.0.0"
  13   "Current version of elopher.")
  14
  15 (defconst elopher-margin-width 6
  16   "Width of left-hand margin used when rendering indicies.")
  17
  18 (defconst elopher-start-index
  19   (mapconcat
  20    'identity
  21    (list "i\tfake\tfake\t1"
  22          "i--------------------------------------------\tfake\tfake\t1"
  23          "i          Elopher Gopher Client             \tfake\tfake\t1"
  24          (format "i              version %s\tfake\tfake\t1" elopher-version)
  25          "i--------------------------------------------\tfake\tfake\t1"
  26          "i\tfake\tfake\t1"
  27          "iBasic usage:\tfake\tfake\t1"
  28          "i\tfake\tfake\t1"
  29          "i - tab/shift-tab: next/prev directory entry on current page\tfake\tfake\t1"
  30          "i - RET/mouse-1: open directory entry under cursor\tfake\tfake\t1"
  31          "i - u: return to parent directory entry\tfake\tfake\t1"
  32          "i - g: go to a particular page\tfake\tfake\t1"
  33          "i - r: redraw current page (using cached contents if available)\tfake\tfake\t1"
  34          "i - R: reload current page (regenerates cache)\tfake\tfake\t1"
  35          "i - d: download directory entry under cursor\tfake\tfake\t1"
  36          "i - w: display the raw server response for the current page\tfake\tfake\t1"
  37          "i\tfake\tfake\t1"
  38          "iPlaces to start exploring Gopherspace:\tfake\tfake\t1"
  39          "i\tfake\tfake\t1"
  40          "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70"
  41          "i\tfake\tfake\t1"
  42          "iAlternatively, select the following item and enter some\tfake\tfake\t1"
  43          "isearch terms:\tfake\tfake\t1"
  44          "i\tfake\tfake\t1"
  45          "7Veronica-2 Gopher Search Engine\t/v2/vs\tgopher.floodgap.com\t70"
  46          ".")
  47    "\r\n")
  48   "Source for elopher start page.")
  49
  50
  51 ;;; Customization group
  52 ;;
  53
  54 (defgroup elopher nil
  55   "A gopher client."
  56   :group 'applications)
  57
  58 (defface elopher-index
  59   '((((background dark)) :foreground "deep sky blue")
  60     (((background light)) :foreground "blue"))
  61   "Face used for index records.")
  62
  63 (defface elopher-text
  64   '((((background dark)) :foreground "white")
  65     (((background light)) :weight bold))
  66   "Face used for text records.")
  67
  68 (defface elopher-info '()
  69   "Face used for info records.")
  70
  71 (defface elopher-image
  72   '((((background dark)) :foreground "green")
  73     (t :foreground "dark green"))
  74   "Face used for image records.")
  75
  76 (defface elopher-search
  77   '((((background light)) :foreground "orange")
  78     (((background dark)) :foreground "dark orange"))
  79   "Face used for search records.")
  80
  81 (defface elopher-url
  82   '((((background dark)) :foreground "yellow")
  83     (((background light)) :foreground "dark red"))
  84   "Face used for url records.")
  85
  86 (defface elopher-binary
  87   '((t :foreground "magenta"))
  88   "Face used for binary records.")
  89
  90 (defface elopher-unknown
  91   '((t :foreground "red"))
  92   "Face used for unknown record types.")
  93
  94 (defface elopher-margin-key
  95   '((((background dark)) :foreground "white"))
  96   "Face used for margin key.")
  97
  98 (defface elopher-margin-brackets
  99   '((t :foreground "blue"))
 100   "Face used for brackets around margin key.")
 101
 102 (defcustom elopher-open-urls-with-eww nil
 103   "If non-nil, open URL selectors using eww.
 104 Otherwise, use the system browser via the BROWSE-URL function."
 105   :type '(boolean))
 106
 107 ;;; Model
 108 ;;
 109
 110 ;; Address
 111
 112 (defun elopher-make-address (selector host port)
 113   (list selector host port))
 114
 115 (defun elopher-address-selector (address)
 116   (car address))
 117
 118 (defun elopher-address-host (address)
 119   (cadr address))
 120
 121 (defun elopher-address-port (address)
 122   (caddr address))
 123
 124 ;; Node
 125
 126 (defun elopher-make-node (parent address getter &optional content pos)
 127   (list parent address getter content pos))
 128
 129 (defun elopher-node-parent (node)
 130   (elt node 0))
 131
 132 (defun elopher-node-address (node)
 133   (elt node 1))
 134
 135 (defun elopher-node-getter (node)
 136   (elt node 2))
 137
 138 (defun elopher-node-content (node)
 139   (elt node 3))
 140
 141 (defun elopher-node-pos (node)
 142   (elt node 4))
 143
 144 (defun elopher-set-node-content (node content)
 145   (setcar (nthcdr 3 node) content))
 146
 147 (defun elopher-set-node-pos (node pos)
 148   (setcar (nthcdr 4 node) pos))
 149
 150 (defun elopher-save-pos ()
 151   (when elopher-current-node
 152     (elopher-set-node-pos elopher-current-node (point))))
 153
 154 (defun elopher-restore-pos ()
 155   (let ((pos (elopher-node-pos elopher-current-node)))
 156     (if pos
 157         (goto-char pos)
 158       (goto-char (point-min)))))
 159
 160 ;; Node graph traversal
 161
 162 (defvar elopher-current-node)
 163
 164 (defun elopher-visit-node (node &optional getter)
 165   "Visit NODE using its own getter or GETTER, if non-nil."
 166   (elopher-save-pos)
 167   (elopher-process-cleanup)
 168   (setq elopher-current-node node)
 169   (if getter
 170       (funcall getter)
 171     (funcall (elopher-node-getter node))))
 172
 173 (defun elopher-visit-parent-node ()
 174   (let ((parent-node (elopher-node-parent elopher-current-node)))
 175     (when parent-node
 176       (elopher-visit-node parent-node))))
 177
 178 (defun elopher-reload-current-node ()
 179   (elopher-set-node-content elopher-current-node nil)
 180   (elopher-visit-node elopher-current-node))
 181
 182 ;;; Buffer preparation
 183 ;;
 184
 185 (defmacro elopher-with-clean-buffer (&rest args)
 186   "Evaluate ARGS with a clean *elopher* buffer as current."
 187   (list 'progn
 188         '(switch-to-buffer "*elopher*")
 189         '(elopher-mode)
 190         (append (list 'let '((inhibit-read-only t))
 191                       '(erase-buffer))
 192                 args)))
 193
 194 ;;; Index rendering
 195 ;;
 196
 197 (defun elopher-insert-index (string)
 198   "Insert the index corresponding to STRING into the current buffer."
 199   (dolist (line (split-string string "\r\n"))
 200     (unless (= (length line) 0)
 201       (elopher-insert-index-record line))))
 202
 203 (defun elopher-insert-margin (&optional type-name)
 204   "Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
 205   (if type-name
 206       (progn
 207         (insert (format (concat "%" (number-to-string (- elopher-margin-width 1)) "s")
 208                         (concat
 209                          (propertize "[" 'face 'elopher-margin-brackets)
 210                          (propertize type-name 'face 'elopher-margin-key)
 211                          (propertize "]" 'face 'elopher-margin-brackets))))
 212         (insert " "))
 213     (insert (make-string elopher-margin-width ?\s))))
 214
 215 (defvar elopher-type-map
 216   '((?0 elopher-get-text-node "T" elopher-text)
 217     (?1 elopher-get-index-node "/" elopher-index)
 218     (?g elopher-get-image-node "im" elopher-image)
 219     (?p elopher-get-image-node "im" elopher-image)
 220     (?I elopher-get-image-node "im" elopher-image)
 221     (?4 elopher-get-node-download "B" elopher-binary)
 222     (?5 elopher-get-node-download "B" elopher-binary)
 223     (?9 elopher-get-node-download "B" elopher-binary)
 224     (?7 elopher-get-search-node "?" elopher-search))
 225   "Association list from types to getters, margin codes and index faces.")
 226
 227 (defun elopher-insert-index-record (line)
 228   "Insert the index record corresponding to LINE into the current buffer."
 229   (let* ((type (elt line 0))
 230          (fields (split-string (substring line 1) "\t"))
 231          (display-string (elt fields 0))
 232          (selector (elt fields 1))
 233          (host (elt fields 2))
 234          (port (elt fields 3))
 235          (address (elopher-make-address selector host port))
 236          (type-map-entry (alist-get type elopher-type-map)))
 237     (if type-map-entry
 238         (let ((getter (car type-map-entry))
 239               (margin-code (cadr type-map-entry))
 240               (face (caddr type-map-entry)))
 241           (elopher-insert-margin margin-code)
 242           (insert-text-button display-string
 243                               'face face
 244                               'elopher-node (elopher-make-node elopher-current-node
 245                                                                address
 246                                                                getter)
 247                               'action #'elopher-click-link
 248                               'follow-link t
 249                               'help-echo (format "mouse-1, RET: open %s on %s port %s"
 250                                                  selector host port)))
 251       (pcase type
 252         (?i (elopher-insert-margin) ; Information
 253             (insert (propertize display-string
 254                                 'face 'elopher-info)))
 255         (?h (elopher-insert-margin "W") ; Web link
 256             (let ((url (elt (split-string selector "URL:") 1)))
 257               (insert-text-button display-string
 258                                   'face 'elopher-url
 259                                   'elopher-url url
 260                                   'action #'elopher-click-url
 261                                   'follow-link t
 262                                   'help-echo (format "mouse-1, RET: open url %s" url))))
 263         (?.) ; Occurs at end of index, can safely ignore.
 264         (tp (elopher-insert-margin (concat (char-to-string tp) "?"))
 265             (insert (propertize display-string
 266                                 'face elopher-unknown-face)))))
 267     (insert "\n")))
 268
 269
 270 ;;; Selector retrieval (all kinds)
 271 ;;
 272
 273 (defun elopher-process-cleanup ()
 274   "Immediately shut down any extant elopher process."
 275   (let ((p (get-process "elopher-process")))
 276     (if p (delete-process p))))
 277
 278 (defvar elopher-selector-string)
 279
 280 (defun elopher-get-selector (address after)
 281   "Retrieve selector specified by ADDRESS, then execute AFTER.
 282 The result is stored as a string in the variable elopher-selector-string."
 283   (setq elopher-selector-string "")
 284   (make-network-process
 285    :name "elopher-process"
 286    :host (elopher-address-host address)
 287    :service (elopher-address-port address)
 288    :filter (lambda (proc string)
 289              (setq elopher-selector-string (concat elopher-selector-string string)))
 290    :sentinel after)
 291   (process-send-string "elopher-process"
 292                        (concat (elopher-address-selector address) "\n")))
 293
 294 ;; Index retrieval
 295
 296 (defun elopher-get-index-node ()
 297   (let ((content (elopher-node-content elopher-current-node))
 298         (address (elopher-node-address elopher-current-node)))
 299     (if content
 300         (progn
 301           (elopher-with-clean-buffer
 302            (insert content))
 303           (elopher-restore-pos))
 304       (if address
 305           (progn
 306             (elopher-with-clean-buffer
 307              (insert "LOADING DIRECTORY..."))
 308             (elopher-get-selector address
 309                                   (lambda (proc event)
 310                                     (unless (string-prefix-p "deleted" event)
 311                                       (elopher-with-clean-buffer
 312                                        (elopher-insert-index elopher-selector-string))
 313                                       (elopher-restore-pos)
 314                                       (elopher-set-node-content elopher-current-node
 315                                                                 (buffer-string))))))
 316         (progn
 317           (elopher-with-clean-buffer
 318            (elopher-insert-index elopher-start-index))
 319           (elopher-restore-pos)
 320           (elopher-set-node-content elopher-current-node
 321                                     (buffer-string)))))))
 322
 323 ;; Text retrieval
 324
 325 (defconst elopher-url-regex "\\(https?\\|gopher\\)://\\([a-zA-Z0-9.\-]+\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?"
 326   "Regexp used to locate and buttinofy URLs in text files loaded by elopher.")
 327
 328 (defun elopher-buttonify-urls (string)
 329   "Turn substrings which look like urls in STRING into clickable buttons."
 330   (with-temp-buffer
 331     (insert string)
 332     (goto-char (point-min))
 333     (while (re-search-forward elopher-url-regex nil t)
 334       (let ((url (match-string 0))
 335             (protocol (downcase (match-string 1))))
 336         (if (string= protocol "gopher")
 337             (let* ((host (match-string 2))
 338                    (port 70)
 339                    (type-and-selector (match-string 4))
 340                    (type (if (> (length type-and-selector) 1)
 341                              (elt type-and-selector 1)
 342                            ?1))
 343                    (selector (if (> (length type-and-selector) 1)
 344                                  (substring type-and-selector 2)
 345                                ""))
 346                    (address (elopher-make-address selector host port))
 347                    (getter (car (alist-get type elopher-type-map))))
 348               (make-text-button (match-beginning 0)
 349                                 (match-end 0)
 350                                 'elopher-node (elopher-make-node elopher-current-node
 351                                                                  address
 352                                                                  getter)
 353                                 'action #'elopher-click-link
 354                                 'follow-link t
 355                                 'help-echo (format "mouse-1, RET: open %s on %s port %s"
 356                                                    selector host port)))
 357           (make-text-button (match-beginning 0)
 358                             (match-end 0)
 359                             'elopher-url url
 360                             'action #'elopher-click-url
 361                             'follow-link t
 362                             'help-echo (format "mouse-1, RET: open url %s" url)))))
 363     (buffer-string)))
 364
 365 (defun elopher-process-text (string)
 366   (let* ((chopped-str (replace-regexp-in-string "\r\n\.\r\n$" "\r\n" string))
 367          (cleaned-str (replace-regexp-in-string "\r" "" chopped-str)))
 368     (elopher-buttonify-urls cleaned-str)))
 369
 370 (defun elopher-get-text-node ()
 371   (let ((content (elopher-node-content elopher-current-node))
 372         (address (elopher-node-address elopher-current-node)))
 373     (if content
 374         (progn
 375           (elopher-with-clean-buffer
 376            (insert content))
 377           (elopher-restore-pos))
 378       (progn
 379         (elopher-with-clean-buffer
 380          (insert "LOADING TEXT..."))
 381         (elopher-get-selector address
 382                               (lambda (proc event)
 383                                 (unless (string-prefix-p "deleted" event)
 384                                   (elopher-with-clean-buffer
 385                                    (insert (elopher-process-text elopher-selector-string)))
 386                                   (elopher-restore-pos)
 387                                   (elopher-set-node-content elopher-current-node
 388                                                             (buffer-string)))))))))
 389
 390 ;; Image retrieval
 391
 392 (defun elopher-get-image-node ()
 393   (let ((content (elopher-node-content elopher-current-node))
 394         (address (elopher-node-address elopher-current-node)))
 395     (if content
 396         (progn
 397           (elopher-with-clean-buffer
 398            (insert-image content))
 399           (setq cursor-type nil)
 400           (elopher-restore-pos))
 401       (progn
 402         (elopher-with-clean-buffer
 403          (insert "LOADING IMAGE..."))
 404         (elopher-get-selector address
 405                               (lambda (proc event)
 406                                 (unless (string-prefix-p "deleted" event)
 407                                   (let ((image (create-image
 408                                                 (string-as-unibyte elopher-selector-string)
 409                                                 nil t)))
 410                                     (elopher-with-clean-buffer
 411                                      (insert-image image))
 412                                     (setq cursor-type nil)
 413                                     (elopher-restore-pos)
 414                                     (elopher-set-node-content elopher-current-node
 415                                                               image)))))))))
 416
 417 ;; Search retrieval
 418
 419 (defun elopher-get-search-node ()
 420   (let ((content (elopher-node-content elopher-current-node))
 421         (address (elopher-node-address elopher-current-node))
 422         (aborted t))
 423     (if content
 424         (progn
 425           (elopher-with-clean-buffer
 426            (insert content))
 427           (elopher-restore-pos)
 428           (message "Displaying cached search results.  Reload to perform a new search."))
 429       (unwind-protect
 430           (let* ((query-string (read-string "Query: "))
 431                  (query-selector (concat (elopher-address-selector address) "\t" query-string))
 432                  (search-address (elopher-make-address query-selector
 433                                                        (elopher-address-host address)
 434                                                        (elopher-address-port address))))
 435             (setq aborted nil)
 436             (elopher-with-clean-buffer
 437              (insert "LOADING RESULTS..."))
 438             (elopher-get-selector search-address
 439                                   (lambda (proc event)
 440                                     (unless (string-prefix-p "deleted" event)
 441                                       (elopher-with-clean-buffer
 442                                        (elopher-insert-index elopher-selector-string))
 443                                       (goto-char (point-min))
 444                                       (elopher-set-node-content elopher-current-node
 445                                                                 (buffer-string))))))
 446         (if aborted
 447             (elopher-visit-parent-node))))))
 448
 449 ;; Raw server response retrieval
 450
 451 (defun elopher-get-node-raw ()
 452   (let* ((content (elopher-node-content elopher-current-node))
 453          (address (elopher-node-address elopher-current-node)))
 454     (elopher-with-clean-buffer
 455      (insert "LOADING RAW SERVER RESPONSE..."))
 456     (if address
 457         (elopher-get-selector address
 458                               (lambda (proc event)
 459                                 (unless (string-prefix-p "deleted" event)
 460                                   (elopher-with-clean-buffer
 461                                    (insert elopher-selector-string))
 462                                   (goto-char (point-min)))))
 463       (progn
 464         (elopher-with-clean-buffer
 465          (insert elopher-start-index))
 466         (goto-char (point-min)))))
 467   (message "Displaying raw server response.  Reload or redraw to return to standard view."))
 468
 469 ;; File export retrieval
 470
 471 (defvar elopher-download-filename)
 472
 473 (defun elopher-get-node-download ()
 474   (let* ((address (elopher-node-address elopher-current-node))
 475          (selector (elopher-address-selector address)))
 476     (elopher-visit-parent-node) ; Do first in case of non-local exits.
 477     (let* ((filename-proposal (file-name-nondirectory selector))
 478            (filename (read-file-name "Save file as: "
 479                                      nil nil nil
 480                                      (if (> (length filename-proposal) 0)
 481                                          filename-proposal
 482                                        "gopher.file"))))
 483       (message "Downloading...")
 484       (setq elopher-download-filename filename)
 485       (elopher-get-selector address
 486                             (lambda (proc event)
 487                               (let ((coding-system-for-write 'binary))
 488                                 (with-temp-file elopher-download-filename
 489                                   (insert elopher-selector-string)
 490                                   (message (format "Download complate, saved to file %s."
 491                                                    elopher-download-filename)))))))))
 492
 493
 494 ;;; Navigation procedures
 495 ;;
 496
 497 (defun elopher-next-link ()
 498   (interactive)
 499   (forward-button 1))
 500
 501 (defun elopher-prev-link ()
 502   (interactive)
 503   (backward-button 1))
 504
 505 (defun elopher-click-link (button)
 506   (let ((node (button-get button 'elopher-node)))
 507     (elopher-visit-node node)))
 508
 509 (defun elopher-click-url (button)
 510   (let ((url (button-get button 'elopher-url)))
 511     (if elopher-open-urls-with-eww
 512         (browse-web url)
 513       (browse-url url))))
 514
 515 (defun elopher-follow-closest-link ()
 516   (interactive)
 517   (push-button))
 518
 519 (defun elopher-go ()
 520   "Go to a particular gopher site."
 521   (interactive)
 522   (let* (
 523          (hostname (read-string "Gopher host: "))
 524          (selector (read-string "Selector (default none): " nil nil ""))
 525          (port (read-string "Port (default 70): " nil nil 70))
 526          (address (list selector hostname port)))
 527     (elopher-visit-node
 528      (elopher-make-node elopher-current-node
 529                         address
 530                         #'elopher-get-index-node))))
 531
 532 (defun  elopher-redraw ()
 533   "Redraw current page."
 534   (interactive)
 535   (elopher-visit-node elopher-current-node))
 536
 537 (defun  elopher-reload ()
 538   "Reload current page."
 539   (interactive)
 540   (elopher-reload-current-node))
 541
 542 (defun elopher-view-raw ()
 543   "View current page as plain text."
 544   (interactive)
 545   (elopher-visit-node elopher-current-node
 546                       #'elopher-get-node-raw))
 547
 548 (defun elopher-back ()
 549   "Go to previous site."
 550   (interactive)
 551   (if (elopher-node-parent elopher-current-node)
 552       (elopher-visit-parent-node)
 553     (message "No previous site.")))
 554
 555 (defun elopher-download ()
 556   "Download the link at point."
 557   (interactive)
 558   (let ((button (button-at (point))))
 559     (if button
 560         (let ((node (button-get button 'elopher-node)))
 561           (if node
 562               (elopher-visit-node (button-get button 'elopher-node)
 563                                   #'elopher-get-node-download)
 564             (message "Can only download gopher links, not general URLs.")))
 565       (message "No link selected."))))
 566
 567 ;;; Mode and keymap
 568 ;;
 569
 570 (defvar elopher-mode-map
 571   (let ((map (make-sparse-keymap)))
 572     (define-key map (kbd "<tab>") 'elopher-next-link)
 573     (define-key map (kbd "<S-tab>") 'elopher-prev-link)
 574     (define-key map (kbd "u") 'elopher-back)
 575     (define-key map (kbd "g") 'elopher-go)
 576     (define-key map (kbd "r") 'elopher-reload)
 577     (define-key map (kbd "w") 'elopher-view-raw)
 578     (define-key map (kbd "d") 'elopher-download)
 579     (when (fboundp 'evil-define-key)
 580       (evil-define-key 'normal map
 581         (kbd "C-]") 'elopher-follow-closest-link
 582         (kbd "C-t") 'elopher-back
 583         (kbd "u") 'elopher-back
 584         (kbd "g") 'elopher-go
 585         (kbd "r") 'elopher-reload
 586         (kbd "w") 'elopher-view-raw
 587         (kbd "d") 'elopher-download))
 588     map)
 589   "Keymap for gopher client.")
 590
 591 (define-derived-mode elopher-mode special-mode "elopher"
 592   "Major mode for elopher, an elisp gopher client.")
 593
 594
 595 ;;; Main start procedure
 596 ;;
 597
 598 (defun elopher ()
 599   "Start elopher with default landing page."
 600   (interactive)
 601   (setq elopher-current-node nil)
 602   (let ((start-node (elopher-make-node nil nil #'elopher-get-index-node)))
 603     (elopher-visit-node start-node))
 604   "Started Elopher.") ; Otherwise (elopher) evaluates to start page string.
 605
 606 ;;; elopher.el ends here