elopher.el

   1 ;;; elopher.el --- gopher client
   2
   3 ;;; Commentary:
   4
   5 ;; Simple gopher client in elisp.
   6
   7 ;;; Code:
   8
   9 (defvar 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     (when (require 'evil nil t)
  15       (evil-define-key 'normal map
  16         (kbd "C-]") 'elopher-follow-closest-link
  17         (kbd "C-t") 'elopher-history-back
  18         (kbd "u") 'elopher-history-back))
  19     map)
  20   "Keymap for gopher client.")
  21
  22 (define-derived-mode elopher-mode special-mode "elopher"
  23   "Major mode for elopher, an elisp gopher client.")
  24
  25 (defvar elopher-margin-width 5)
  26
  27 (defun elopher-insert-margin (&optional type-name)
  28   (if type-name
  29       (insert (propertize
  30                (format (concat "%" (number-to-string elopher-margin-width) "s")
  31                        (concat "[" type-name "] "))
  32                'face '(foreground-color . "yellow")))
  33     (insert (make-string elopher-margin-width ?\s))))
  34
  35 (defun elopher-process-record (line)
  36   (let* ((type (elt line 0))
  37          (fields (split-string (substring line 1) "\t"))
  38          (display-string (elt fields 0))
  39          (selector (elt fields 1))
  40          (hostname (elt fields 2))
  41          (port (elt fields 3))
  42          (address (list selector hostname port)))
  43     (pcase type
  44       (?i (elopher-insert-margin)
  45           (insert (propertize display-string
  46                               'face '(foreground-color. "gray"))))
  47       (?0 (elopher-insert-margin "T")
  48           (insert-text-button display-string
  49                               'face '(foreground-color . "white")
  50                               'link-getter #'elopher-get-text
  51                               'link-address address
  52                               'action #'elopher-click-link
  53                               'follow-link t))
  54       (?1 (elopher-insert-margin "/")
  55           (insert-text-button display-string
  56                               'face '(foreground-color . "yellow")
  57                               'link-getter #'elopher-get-index
  58                               'link-address address
  59                               'action #'elopher-click-link
  60                               'follow-link t))
  61       (?p (elopher-insert-margin "img")
  62           (insert-text-button display-string
  63                              'face '(foreground-color . "cyan")
  64                              'link-getter #'elopher-get-image
  65                              'link-address address
  66                              'action #'elopher-click-link
  67                              'follow-link t))
  68       (?.) ; Occurs at end of index, can safely ignore.
  69       (tp (elopher-insert-margin (concat (char-to-string tp) "?"))
  70           (insert (propertize display-string
  71                               'face '(foreground-color . "red")))))
  72     (insert "\n")))
  73
  74 (defvar elopher-incomplete-record "")
  75
  76 (defun elopher-process-complete-records (string)
  77   (let* ((til-now (string-join (list elopher-incomplete-record string)))
  78          (lines (split-string til-now "\r\n")))
  79     (dotimes (idx (length lines))
  80       (if (< idx (- (length lines) 1))
  81           (let ((line (elt lines idx)))
  82             (unless (string-empty-p line)
  83               (elopher-process-record line)))
  84         (setq elopher-incomplete-record (elt lines idx))))))
  85
  86 (defun elopher-get-selector (selector host port filter)
  87   (switch-to-buffer "*elopher*")
  88   (elopher-mode)
  89   (let ((inhibit-read-only t))
  90     (erase-buffer))
  91   (setq elopher-incomplete-record "")
  92   (make-network-process
  93    :name "elopher-process"
  94    :host host
  95    :service (if port port 70)
  96    :filter filter)
  97   (process-send-string "elopher-process" (concat selector "\n")))
  98
  99 (defun elopher-index-filter (proc string)
 100   (with-current-buffer (get-buffer "*elopher*")
 101     (let ((marker (process-mark proc))
 102           (inhibit-read-only t))
 103       (if (not (marker-position marker))
 104           (set-marker marker 0 (current-buffer)))
 105       (save-excursion
 106         (goto-char marker)
 107         (elopher-process-complete-records string)
 108         (set-marker marker (point))))))
 109
 110 (defun elopher-get-index (selector host port)
 111   (elopher-get-selector selector host port #'elopher-index-filter))
 112
 113 (defun elopher-text-filter (proc string)
 114   (with-current-buffer (get-buffer "*elopher*")
 115     (let ((marker (process-mark proc))
 116           (inhibit-read-only t))
 117       (if (not (marker-position marker))
 118           (set-marker marker 0 (current-buffer)))
 119       (save-excursion
 120         (goto-char marker)
 121         (dolist (line (split-string string "\r"))
 122           (insert line))
 123         (set-marker marker (point))))))
 124
 125 (defun elopher-get-text (selector host port)
 126   (elopher-get-selector selector host port #'elopher-text-filter))
 127
 128 (defvar elopher-image-buffer "")
 129
 130 (defun elopher-image-filter (proc string)
 131   (setq elopher-image-buffer (concat elopher-image-buffer string)))
 132
 133 (defun elopher-get-image (selector host port)
 134   (setq elopher-image-buffer "")
 135   (elopher-get-selector selector host port #'elopher-image-filter)
 136   (insert-image (create-image elopher-image-buffer)))
 137
 138 (defun elopher-history-back ()
 139   (interactive)
 140   (let ((inhibit-read-only t))
 141     (undo)))
 142
 143 (defun elopher-next-link ()
 144   (interactive)
 145   (forward-button 1))
 146
 147 (defun elopher-prev-link ()
 148   (interactive)
 149   (backward-button 1))
 150
 151 (defun elopher-click-link (button)
 152   (apply (button-get button 'link-getter) (button-get button 'link-address)))
 153
 154 (defun elopher-follow-closest-link ()
 155   (interactive)
 156   (push-button))
 157
 158 (defun elopher ()
 159   "Start gopher client."
 160   (interactive)
 161   (elopher-get-index "" (read-from-minibuffer "Gopher host: ") 70))
 162
 163 (elopher-get-index "" "gopher.floodgap.com" 70)
 164 ;; (elopher-get-image "/fun/xkcd/comics/2130/2137/text_entry.png" "gopher.floodgap.com" 70)
 165
 166 ;;; elopher.el ends here