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 &optional sentinel)
  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    :sentinel sentinel)
  98   (process-send-string "elopher-process" (concat selector "\n")))
  99
 100 (defun elopher-index-filter (proc string)
 101   (with-current-buffer (get-buffer "*elopher*")
 102     (let ((marker (process-mark proc))
 103           (inhibit-read-only t))
 104       (if (not (marker-position marker))
 105           (set-marker marker 0 (current-buffer)))
 106       (save-excursion
 107         (goto-char marker)
 108         (elopher-process-complete-records string)
 109         (set-marker marker (point))))))
 110
 111 (defun elopher-get-index (selector host port)
 112   (elopher-get-selector selector host port #'elopher-index-filter))
 113
 114 (defun elopher-text-filter (proc string)
 115   (with-current-buffer (get-buffer "*elopher*")
 116     (let ((marker (process-mark proc))
 117           (inhibit-read-only t))
 118       (if (not (marker-position marker))
 119           (set-marker marker 0 (current-buffer)))
 120       (save-excursion
 121         (goto-char marker)
 122         (dolist (line (split-string string "\r"))
 123           (insert line))
 124         (set-marker marker (point))))))
 125
 126 (defun elopher-get-text (selector host port)
 127   (elopher-get-selector selector host port #'elopher-text-filter))
 128
 129 (defvar elopher-image-buffer "")
 130
 131 (defun elopher-image-filter (proc string)
 132   (setq elopher-image-buffer (concat elopher-image-buffer string)))
 133
 134 (defun elopher-image-sentinel (proc event)
 135   (let ((inhibit-read-only t))
 136     (insert-image (create-image elopher-image-buffer))))
 137
 138 (defun elopher-get-image (selector host port)
 139   (setq elopher-image-buffer "")
 140   (elopher-get-selector selector host port #'elopher-image-filter #'elopher-image-sentinel))
 141
 142 (defun elopher-history-back ()
 143   (interactive)
 144   (let ((inhibit-read-only t))
 145     (undo)))
 146
 147 (defun elopher-next-link ()
 148   (interactive)
 149   (forward-button 1))
 150
 151 (defun elopher-prev-link ()
 152   (interactive)
 153   (backward-button 1))
 154
 155 (defun elopher-click-link (button)
 156   (apply (button-get button 'link-getter) (button-get button 'link-address)))
 157
 158 (defun elopher-follow-closest-link ()
 159   (interactive)
 160   (push-button))
 161
 162 (defun elopher ()
 163   "Start gopher client."
 164   (interactive)
 165   (elopher-get-index "" (read-from-minibuffer "Gopher host: ") 70))
 166
 167 ;; (elopher-get-index "" "gopher.floodgap.com" 70)
 168 (elopher-get-image "/fun/xkcd/comics/2130/2137/text_entry.png" "gopher.floodgap.com" 70)
 169
 170 ;;; elopher.el ends here