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