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 variables
  30 ;;
  31
  32 (defvar elopher-version "1.0.0"
  33   "Current version of elopher.")
  34
  35 (defvar elopher-margin-width 6
  36   "Width of left-hand margin used when rendering indicies.")
  37
  38 (defvar elopher-history nil
  39   "List of pages in elopher history.")
  40
  41 (defvar elopher-start-page
  42   (concat "i\tfake\tfake\t1\r\n"
  43           "i--------------------------------------------\tfake\tfake\t1\r\n"
  44           "i          Elopher Gopher Client             \tfake\tfake\t1\r\n"
  45           (format "i              version %s\tfake\tfake\t1\r\n" elopher-version)
  46           "i--------------------------------------------\tfake\tfake\t1\r\n"
  47           "i\tfake\tfake\t1\r\n"
  48           "iBasic usage:\tfake\tfake\t1\r\n"
  49           "i - tab/shift-tab: next/prev directory entry\tfake\tfake\t1\r\n"
  50           "i - RET/mouse-1: open directory entry\tfake\tfake\t1\r\n"
  51           "i - u: return to parent directory entry\tfake\tfake\t1\r\n"
  52           "i - g: go to a particular site\tfake\tfake\t1\r\n"
  53           "i\tfake\tfake\t1\r\n"
  54           "iPlaces to start exploring Gopherspace:\tfake\tfake\t1\r\n"
  55           "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70\r\n"
  56           "1Super-Dimensional Fortress\t\tsdf.org\t70\r\n"
  57           "i\tfake\tfake\t1\r\n"
  58           "iTest entries:\tfake\tfake\t1\r\n"
  59           "pXKCD comic image\t/fun/xkcd/comics/2130/2137/text_entry.png\tgopher.floodgap.com\t70\r\n"))
  60
  61
  62 ;;; Mode and keymap
  63 ;;
  64
  65 (defvar elopher-mode-map
  66   (let ((map (make-sparse-keymap)))
  67     (define-key map (kbd "<tab>") 'elopher-next-link)
  68     (define-key map (kbd "<S-tab>") 'elopher-prev-link)
  69     (define-key map (kbd "u") 'elopher-history-back)
  70     (define-key map (kbd "g") 'elopher-go)
  71     (when (require 'evil nil t)
  72       (evil-define-key 'normal map
  73         (kbd "C-]") 'elopher-follow-closest-link
  74         (kbd "C-t") 'elopher-history-back
  75         (kbd "u") 'elopher-history-back
  76         (kbd "g") 'elopher-go))
  77     map)
  78   "Keymap for gopher client.")
  79
  80 (define-derived-mode elopher-mode special-mode "elopher"
  81   "Major mode for elopher, an elisp gopher client.")
  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 ;;; Selector retrieval
 146 ;;
 147
 148 (defun elopher-get-selector (selector host port filter &optional sentinel)
 149   (switch-to-buffer "*elopher*")
 150   (push (buffer-string) elopher-history)
 151   (elopher-mode)
 152   (let ((inhibit-read-only t))
 153     (erase-buffer))
 154   (make-network-process
 155    :name "elopher-process"
 156    :host host
 157    :service (if port port 70)
 158    :filter filter
 159    :sentinel sentinel)
 160   (process-send-string "elopher-process" (concat selector "\n")))
 161
 162 ;; Index retrieval
 163
 164 (defun elopher-index-filter (proc string)
 165   (let ((marker (process-mark proc))
 166         (inhibit-read-only t))
 167     (if (not (marker-position marker))
 168         (set-marker marker 0 (current-buffer)))
 169     (save-excursion
 170       (goto-char marker)
 171       (elopher-render-complete-records string)
 172       (set-marker marker (point)))))
 173
 174 (defun elopher-get-index (selector host port)
 175   (setq elopher-incomplete-record "")
 176   (elopher-get-selector selector host port
 177                         #'elopher-index-filter))
 178
 179 ;; Text retrieval
 180
 181 (defun elopher-text-filter (proc string)
 182   (let ((marker (process-mark proc))
 183         (inhibit-read-only t))
 184     (if (not (marker-position marker))
 185         (set-marker marker 0 (current-buffer)))
 186     (save-excursion
 187       (goto-char marker)
 188       (dolist (line (split-string string "\r"))
 189         (insert line))
 190       (set-marker marker (point)))))
 191
 192 (defun elopher-get-text (selector host port)
 193   (elopher-get-selector selector host port
 194                         #'elopher-text-filter))
 195
 196 ;; Image retrieval
 197
 198 (defvar elopher-image-buffer "")
 199
 200 (defun elopher-image-filter (proc string)
 201   (setq elopher-image-buffer (concat elopher-image-buffer string)))
 202
 203 (defun elopher-image-sentinel (proc event)
 204   (let ((inhibit-read-only t))
 205     (insert-image (create-image elopher-image-buffer))))
 206
 207 (defun elopher-get-image (selector host port)
 208   (setq elopher-image-buffer "")
 209   (elopher-get-selector selector host port
 210                         #'elopher-image-filter
 211                         #'elopher-image-sentinel))
 212
 213 ;;; Control methods for binding
 214 ;;
 215
 216 (defun elopher-history-back ()
 217   (interactive)
 218   (when elopher-history
 219     (let ((inhibit-read-only t))
 220       (erase-buffer)
 221       (save-excursion
 222         (insert (pop elopher-history))))))
 223
 224 (defun elopher-next-link ()
 225   (interactive)
 226   (forward-button 1))
 227
 228 (defun elopher-prev-link ()
 229   (interactive)
 230   (backward-button 1))
 231
 232 (defun elopher-click-link (button)
 233   (apply (button-get button 'link-getter) (button-get button 'link-address)))
 234
 235 (defun elopher-follow-closest-link ()
 236   (interactive)
 237   (push-button))
 238
 239 (defun elopher-go ()
 240   "Go to a particular gopher site."
 241   (interactive)
 242   (elopher-get-index "" (read-from-minibuffer "Gopher host: ") 70))
 243
 244 ;;; Main start procedure
 245 ;;
 246
 247 (defun elopher ()
 248   "Start elopher with default landing page."
 249   (interactive)
 250   (switch-to-buffer "*elopher*")
 251   (elopher-mode)
 252   (setq elopher-history nil)
 253   (let ((inhibit-read-only t))
 254     (erase-buffer)
 255     (save-excursion
 256       (elopher-render-complete-records elopher-start-page))))
 257
 258 ;; (elopher)
 259 ;; (elopher-get-index "" "gopher.floodgap.com" 70)
 260 ;; (elopher-get-image "/fun/xkcd/comics/2130/2137/text_entry.png" "gopher.floodgap.com" 70)
 261
 262 ;;; elopher.el ends here