elopher.el

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