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