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