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