elopher.el

   1 ;;; elopher.el --- gopher client
   2
   3 ;;; Commentary:
   4
   5 ;; Simple gopher client in elisp.
   6
   7 ;;; Code:
   8
   9 (setq elopher-mode-map
  10   (let ((map (make-sparse-keymap)))
  11     (define-key map (kbd "<tab>") 'elopher-next-link)
  12     (define-key map (kbd "<S-tab>") 'elopher-prev-link)
  13     (define-key map (kbd "u") 'elopher-history-back)
  14     (define-key map (kbd "g") 'elopher-go)
  15     (when (require 'evil nil t)
  16       (evil-define-key 'normal map
  17         (kbd "C-]") 'elopher-follow-closest-link
  18         (kbd "C-t") 'elopher-history-back
  19         (kbd "u") 'elopher-history-back
  20         (kbd "g") 'elopher-go))
  21     map))
  22   ;; "Keymap for gopher client.")
  23
  24 (define-derived-mode elopher-mode special-mode "elopher"
  25   "Major mode for elopher, an elisp gopher client.")
  26
  27 (defvar elopher-margin-width 5)
  28
  29 (defun elopher-insert-margin (&optional type-name)
  30   (if type-name
  31       (insert (propertize
  32                (format (concat "%" (number-to-string elopher-margin-width) "s")
  33                        (concat "[" type-name "] "))
  34                'face '(foreground-color . "orange")))
  35     (insert (make-string elopher-margin-width ?\s))))
  36
  37 (defun elopher-render-record (line)
  38   (let* ((type (elt line 0))
  39          (fields (split-string (substring line 1) "\t"))
  40          (display-string (elt fields 0))
  41          (selector (elt fields 1))
  42          (hostname (elt fields 2))
  43          (port (elt fields 3))
  44          (address (list selector hostname port)))
  45     (pcase type
  46       (?i (elopher-insert-margin)
  47           (insert (propertize display-string
  48                               'face '(foreground-color . "gray"))))
  49       (?0 (elopher-insert-margin "T")
  50           (insert-text-button display-string
  51                               'face '(foreground-color . "white")
  52                               'link-getter #'elopher-get-text
  53                               'link-address address
  54                               'action #'elopher-click-link
  55                               'follow-link t))
  56       (?1 (elopher-insert-margin "/")
  57           (insert-text-button display-string
  58                               'face '(foreground-color . "cyan")
  59                               'link-getter #'elopher-get-index
  60                               'link-address address
  61                               'action #'elopher-click-link
  62                               'follow-link t))
  63       (?p (elopher-insert-margin "img")
  64           (insert-text-button display-string
  65                              'face '(foreground-color . "cyan")
  66                              'link-getter #'elopher-get-image
  67                              'link-address address
  68                              'action #'elopher-click-link
  69                              'follow-link t))
  70       (?.) ; Occurs at end of index, can safely ignore.
  71       (tp (elopher-insert-margin (concat (char-to-string tp) "?"))
  72           (insert (propertize display-string
  73                               'face '(foreground-color . "red")))))
  74     (insert "\n")))
  75
  76 (defvar elopher-incomplete-record "")
  77
  78 (defun elopher-render-complete-records (string)
  79   (let* ((til-now (string-join (list elopher-incomplete-record string)))
  80          (lines (split-string til-now "\r\n")))
  81     (dotimes (idx (length lines))
  82       (if (< idx (- (length lines) 1))
  83           (let ((line (elt lines idx)))
  84             (unless (string-empty-p line)
  85               (elopher-render-record line)))
  86         (setq elopher-incomplete-record (elt lines idx))))))
  87
  88 (defun elopher-get-selector (selector host port filter &optional sentinel)
  89   (switch-to-buffer "*elopher*")
  90   (elopher-mode)
  91   (let ((inhibit-read-only t))
  92     (erase-buffer))
  93   (make-network-process
  94    :name "elopher-process"
  95    :host host
  96    :service (if port port 70)
  97    :filter filter
  98    :sentinel sentinel)
  99   (process-send-string "elopher-process" (concat selector "\n")))
 100
 101 (defun elopher-index-filter (proc string)
 102   (with-current-buffer (get-buffer "*elopher*")
 103     (let ((marker (process-mark proc))
 104           (inhibit-read-only t))
 105       (if (not (marker-position marker))
 106           (set-marker marker 0 (current-buffer)))
 107       (save-excursion
 108         (goto-char marker)
 109         (elopher-render-complete-records string)
 110         (set-marker marker (point))))))
 111
 112 (defun elopher-get-index (selector host port)
 113   (setq elopher-incomplete-record "")
 114   (elopher-get-selector selector host port #'elopher-index-filter))
 115
 116 (defun elopher-text-filter (proc string)
 117   (with-current-buffer (get-buffer "*elopher*")
 118     (let ((marker (process-mark proc))
 119           (inhibit-read-only t))
 120       (if (not (marker-position marker))
 121           (set-marker marker 0 (current-buffer)))
 122       (save-excursion
 123         (goto-char marker)
 124         (dolist (line (split-string string "\r"))
 125           (insert line))
 126         (set-marker marker (point))))))
 127
 128 (defun elopher-get-text (selector host port)
 129   (elopher-get-selector selector host port #'elopher-text-filter))
 130
 131 (defvar elopher-image-buffer "")
 132
 133 (defun elopher-image-filter (proc string)
 134   (setq elopher-image-buffer (concat elopher-image-buffer string)))
 135
 136 (defun elopher-image-sentinel (proc event)
 137   (let ((inhibit-read-only t))
 138     (insert-image (create-image elopher-image-buffer))))
 139
 140 (defun elopher-get-image (selector host port)
 141   (setq elopher-image-buffer "")
 142   (elopher-get-selector selector host port #'elopher-image-filter #'elopher-image-sentinel))
 143
 144 (defun elopher-history-back ()
 145   (interactive)
 146   (let ((inhibit-read-only t))
 147     (undo)))
 148
 149 (defun elopher-next-link ()
 150   (interactive)
 151   (forward-button 1))
 152
 153 (defun elopher-prev-link ()
 154   (interactive)
 155   (backward-button 1))
 156
 157 (defun elopher-click-link (button)
 158   (apply (button-get button 'link-getter) (button-get button 'link-address)))
 159
 160 (defun elopher-follow-closest-link ()
 161   (interactive)
 162   (push-button))
 163
 164 (defun elopher-go ()
 165   "Go to a particular gopher site."
 166   (interactive)
 167   (elopher-get-index "" (read-from-minibuffer "Gopher host: ") 70))
 168
 169 (defun elopher ()
 170   "Start elopher with default landing page."
 171   (interactive)
 172   (switch-to-buffer "*elopher*")
 173   (elopher-mode)
 174   (let ((inhibit-read-only t))
 175     (erase-buffer)
 176     (save-excursion
 177       (elopher-render-complete-records
 178        (concat "i\tfake\tfake\t1\r\n"
 179                "i--------------------------------------------\tfake\tfake\t1\r\n"
 180                "i          Elopher Gopher Client             \tfake\tfake\t1\r\n"
 181                "i              version 1.0                   \tfake\tfake\t1\r\n"
 182                "i--------------------------------------------\tfake\tfake\t1\r\n"
 183                "i\tfake\tfake\t1\r\n"
 184                "iBasic usage:\tfake\tfake\t1\r\n"
 185                "i - tab/shift-tab: next/prev directory entry\tfake\tfake\t1\r\n"
 186                "i - RET/mouse-1: open directory entry\tfake\tfake\t1\r\n"
 187                "i - u: return to parent directory entry\tfake\tfake\t1\r\n"
 188                "i - g: go to a particular site\tfake\tfake\t1\r\n"
 189                "i\tfake\tfake\t1\r\n"
 190                "iPlaces to start exploring Gopherspace:\tfake\tfake\t1\r\n"
 191                "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70\r\n"
 192                "1Super-Dimensional Fortress\t\tgopher.floodgap.com\t70\r\n"
 193                "i\tfake\tfake\t1\r\n"
 194                "iTest entries:\tfake\tfake\t1\r\n"
 195                "pXKCD comic image\t/fun/xkcd/comics/2130/2137/text_entry.png\tgopher.floodgap.com\t70\r\n")))))
 196
 197 (elopher)
 198 ;; (elopher-get-index "" "gopher.floodgap.com" 70)
 199 ;; (elopher-get-image "/fun/xkcd/comics/2130/2137/text_entry.png" "gopher.floodgap.com" 70)
 200
 201 ;;; elopher.el ends here