elopher.el

   1 ;;; elopher.el --- gopher client
   2
   3 ;;; Commentary:
   4
   5 ;; Simple gopher client in elisp.
   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-page
  19   (string-join
  20    (list "i\tfake\tfake\t1"
  21          "i--------------------------------------------\tfake\tfake\t1"
  22          "i          Elopher Gopher Client             \tfake\tfake\t1"
  23          (format "i              version %s\tfake\tfake\t1" elopher-version)
  24          "i--------------------------------------------\tfake\tfake\t1"
  25          "i\tfake\tfake\t1"
  26          "iBasic usage:\tfake\tfake\t1"
  27          "i - tab/shift-tab: next/prev directory entry\tfake\tfake\t1"
  28          "i - RET/mouse-1: open directory entry\tfake\tfake\t1"
  29          "i - u: return to parent directory entry\tfake\tfake\t1"
  30          "i - g: go to a particular site\tfake\tfake\t1"
  31          "i - r: reload current page\tfake\tfake\t1"
  32          "i\tfake\tfake\t1"
  33          "iPlaces to start exploring Gopherspace:\tfake\tfake\t1"
  34          "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70"
  35          "1Super-Dimensional Fortress\t\tsdf.org\t70"
  36          "i\tfake\tfake\t1"
  37          "iTest entries:\tfake\tfake\t1"
  38          "pXKCD comic image\t/fun/xkcd/comics/2130/2137/text_entry.png\tgopher.floodgap.com\t70"
  39          "1Test server\t\tlocalhost\t70"
  40          ".")
  41    "\r\n"))
  42
  43
  44 ;;; Customization group
  45 ;;
  46
  47 (defgroup elopher nil
  48   "A simple gopher client."
  49   :group 'applications)
  50
  51 (defcustom elopher-index-face '(foreground-color . "cyan")
  52   "Face used for index records.")
  53 (defcustom elopher-text-face '(foreground-color . "white")
  54   "Face used for text records.")
  55 (defcustom elopher-info-face '(foreground-color . "gray")
  56   "Face used for info records.")
  57 (defcustom elopher-image-face '(foreground-color . "green")
  58   "Face used for image records.")
  59 (defcustom elopher-unknown-face '(foreground-color . "red")
  60   "Face used for unknown record types.")
  61
  62 ;;; Model
  63 ;;
  64
  65 ;; Address
  66
  67 (defun elopher-make-address (selector host port)
  68   (list selector host port))
  69
  70 (defun elopher-address-selector (address)
  71   (car address))
  72
  73 (defun elopher-address-host (address)
  74   (cadr address))
  75
  76 (defun elopher-address-port (address)
  77   (caddr address))
  78
  79 ;; Node
  80
  81 (defun elopher-make-node (parent address getter &optional content)
  82   (list parent address getter content))
  83
  84 (defun elopher-node-parent (node)
  85   (car node))
  86
  87 (defun elopher-node-address (node)
  88   (cadr node))
  89
  90 (defun elopher-node-getter (node)
  91   (caddr node))
  92
  93 (defun elopher-node-content (node)
  94   (cadddr node))
  95
  96 (defun elopher-set-node-content (node content)
  97   (setcar (cdddr node) content))
  98
  99 ;; Node graph traversal
 100
 101 (defvar elopher-start-node (elopher-make-node nil nil #'elopher-get-index-node))
 102 (defvar elopher-current-node)
 103
 104 (defun elopher-visit-node (node)
 105   (elopher-prepare-buffer)
 106   (setq elopher-current-node node)
 107   (funcall (elopher-node-getter node)))
 108
 109 (defun elopher-visit-parent-node ()
 110   (let ((parent-node (elopher-node-parent elopher-current-node)))
 111     (when parent-node
 112       (setq elopher-current-node parent-node)
 113       (elopher-visit-node elopher-current-node))))
 114
 115 (defun elopher-reload-current-node ()
 116   (elopher-set-node-content elopher-current-node nil)
 117   (elopher-visit-node elopher-current-node))
 118
 119
 120 ;;; Buffer preparation
 121 ;;
 122
 123 (defun elopher-prepare-buffer ()
 124   (switch-to-buffer "*elopher*")
 125   (elopher-mode)
 126   (let ((inhibit-read-only t))
 127     (erase-buffer)))
 128
 129
 130 ;;; Index rendering
 131 ;;
 132
 133 (defun elopher-insert-index (string)
 134   "Inserts the index corresponding to STRING into the current buffer."
 135   (dolist (line (split-string string "\r\n"))
 136     (unless (string-empty-p line)
 137       (elopher-insert-index-record line))))
 138
 139 (defun elopher-insert-margin (&optional type-name)
 140   (if type-name
 141       (progn
 142         (insert (format (concat "%" (number-to-string (- elopher-margin-width 1)) "s")
 143                         (concat
 144                          (propertize "[" 'face '(foreground-color . "blue"))
 145                          (propertize type-name 'face '(foreground-color . "white"))
 146                          (propertize "]" 'face '(foreground-color . "blue")))))
 147         (insert " "))
 148     (insert (make-string elopher-margin-width ?\s))))
 149
 150 (defun elopher-insert-index-record (line)
 151   "Inserts the index record corresponding to LINE into the current buffer."
 152   (let* ((type (elt line 0))
 153          (fields (split-string (substring line 1) "\t"))
 154          (display-string (elt fields 0))
 155          (address (elopher-make-address (elt fields 1) (elt fields 2) (elt fields 3))))
 156     (pcase type
 157       (?i (elopher-insert-margin)
 158           (insert (propertize display-string
 159                               'face elopher-info-face)))
 160       (?0 (elopher-insert-margin "T")
 161           (insert-text-button display-string
 162                               'face elopher-text-face
 163                               'elopher-node (elopher-make-node elopher-current-node
 164                                                                address
 165                                                                #'elopher-get-text-node)
 166                               'action #'elopher-click-link
 167                               'follow-link t))
 168       (?1 (elopher-insert-margin "/")
 169           (insert-text-button display-string
 170                               'face elopher-index-face
 171                               'elopher-node (elopher-make-node elopher-current-node
 172                                                                address
 173                                                                #'elopher-get-index-node)
 174                               'action #'elopher-click-link
 175                               'follow-link t))
 176       (?.) ; Occurs at end of index, can safely ignore.
 177       (tp (elopher-insert-margin (concat (char-to-string tp) "?"))
 178           (insert (propertize display-string
 179                               'face elopher-unknown-face))))
 180     (insert "\n")))
 181
 182
 183 ;;; Selector retrieval (all kinds)
 184 ;;
 185
 186 (defvar elopher-selector-string)
 187
 188 (defun elopher-get-selector (address after)
 189   (setq elopher-selector-string "")
 190   (let ((p (get-process "elopher-process")))
 191     (if p (delete-process p)))
 192   (make-network-process
 193    :name "elopher-process"
 194    :host (elopher-address-host address)
 195    :service (elopher-address-port address)
 196    :filter (lambda (proc string)
 197              (setq elopher-selector-string (concat elopher-selector-string string)))
 198    :sentinel after)
 199   (process-send-string "elopher-process"
 200                        (concat (elopher-address-selector address) "\n")))
 201
 202 ;; Index retrieval
 203
 204 (defun elopher-get-index-node ()
 205   (let ((content (elopher-node-content elopher-current-node))
 206         (address (elopher-node-address elopher-current-node)))
 207     (if content
 208         (let ((inhibit-read-only t))
 209           (save-excursion
 210             (insert content)))
 211       (if address
 212           (elopher-get-selector address
 213                                 (lambda (proc event)
 214                                   (let ((inhibit-read-only t))
 215                                     (erase-buffer)
 216                                     (save-excursion
 217                                       (elopher-insert-index elopher-selector-string)))
 218                                   (elopher-set-node-content elopher-current-node
 219                                                             (buffer-string))))
 220         (progn
 221           (let ((inhibit-read-only t))
 222             (erase-buffer)
 223             (save-excursion
 224               (elopher-insert-index elopher-start-page)))
 225           (elopher-set-node-content elopher-current-node
 226                                     (buffer-string)))))))
 227
 228 ;; Text retrieval
 229
 230 (defun elopher-strip-CRs (string)
 231   (replace-regexp-in-string "\r" "" string))
 232
 233 (defun elopher-get-text-node ()
 234   (let ((content (elopher-node-content elopher-current-node))
 235         (address (elopher-node-address elopher-current-node)))
 236     (if content
 237         (let ((inhibit-read-only t))
 238           (save-excursion
 239             (insert content)))
 240       (elopher-get-selector address
 241                             (lambda (proc event)
 242                               (let ((inhibit-read-only t))
 243                                 (erase-buffer)
 244                                 (save-excursion
 245                                   (insert
 246                                    (elopher-strip-CRs elopher-selector-string))))
 247                               (elopher-set-node-content elopher-current-node
 248                                                         (buffer-string)))))))
 249
 250 ;;; Navigation methods
 251 ;;
 252
 253 (defun elopher-next-link ()
 254   (interactive)
 255   (forward-button 1))
 256
 257 (defun elopher-prev-link ()
 258   (interactive)
 259   (backward-button 1))
 260
 261 (defun elopher-click-link (button)
 262   (let ((node (button-get button 'elopher-node)))
 263     (elopher-visit-node node)))
 264
 265 (defun elopher-follow-closest-link ()
 266   (interactive)
 267   (push-button))
 268
 269 (defun elopher-go ()
 270   "Go to a particular gopher site."
 271   (interactive)
 272   (let* ((selector "")
 273          (hostname (read-from-minibuffer "Gopher host: "))
 274          (port 70)
 275          (address (list selector hostname port)))
 276     (elopher-visit-node
 277      (elopher-make-node elopher-current-node
 278                         address
 279                         #'elopher-get-index-node))))
 280
 281 (defun  elopher-reload ()
 282   "Reload current site."
 283   (interactive)
 284   (elopher-reload-current-node))
 285
 286 (defun elopher-back ()
 287   "Go to previous site."
 288   (interactive)
 289   (elopher-visit-parent-node))
 290
 291 ;;; Main start procedure
 292 ;;
 293 (defun elopher ()
 294   "Start elopher with default landing page."
 295   (interactive)
 296   (elopher-visit-node elopher-start-node))
 297
 298
 299 ;;; Mode and keymap
 300 ;;
 301
 302 (defvar elopher-mode-map
 303   (let ((map (make-sparse-keymap)))
 304     (define-key map (kbd "<tab>") 'elopher-next-link)
 305     (define-key map (kbd "<S-tab>") 'elopher-prev-link)
 306     (define-key map (kbd "u") 'elopher-back)
 307     (define-key map (kbd "g") 'elopher-go)
 308     (define-key map (kbd "r") 'elopher-reload)
 309     (when (require 'evil nil t)
 310       (evil-define-key 'normal map
 311         (kbd "C-]") 'elopher-follow-closest-link
 312         (kbd "C-t") 'elopher-back
 313         (kbd "u") 'elopher-back
 314         (kbd "g") 'elopher-go
 315         (kbd "r") 'elopher-reload))
 316     map)
 317   "Keymap for gopher client.")
 318
 319 (define-derived-mode elopher-mode special-mode "elopher"
 320   "Major mode for elopher, an elisp gopher client.")
 321
 322
 323 ;;; elopher.el ends here