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