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