elopher.el

   1 ;;; elopher.el --- gopher client
   2
   3 ;;; Commentary:
   4
   5 ;; Simple gopher client in elisp.
   6
   7 ;;; Code:
   8
   9 ;;; Global constants
  10 ;;
  11
  12 (defconst elopher-version "1.0.0"
  13   "Current version of elopher.")
  14
  15 (defconst elopher-margin-width 6
  16   "Width of left-hand margin used when rendering indicies.")
  17
  18 (defconst elopher-start-index
  19   (string-join
  20    (list "i\tfake\tfake\t1"
  21          "i--------------------------------------------\tfake\tfake\t1"
  22          "i          Elopher Gopher Client             \tfake\tfake\t1"
  23          (format "i              version %s\tfake\tfake\t1" elopher-version)
  24          "i--------------------------------------------\tfake\tfake\t1"
  25          "i\tfake\tfake\t1"
  26          "iBasic usage:\tfake\tfake\t1"
  27          "i - tab/shift-tab: next/prev directory entry\tfake\tfake\t1"
  28          "i - RET/mouse-1: open directory entry\tfake\tfake\t1"
  29          "i - u: return to parent directory entry\tfake\tfake\t1"
  30          "i - g: go to a particular site\tfake\tfake\t1"
  31          "i - r: reload current page\tfake\tfake\t1"
  32          "i\tfake\tfake\t1"
  33          "iPlaces to start exploring Gopherspace:\tfake\tfake\t1"
  34          "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70"
  35          "1Super-Dimensional Fortress\t\tsdf.org\t70"
  36          "i\tfake\tfake\t1"
  37          "iTest entries:\tfake\tfake\t1"
  38          "pXKCD comic image\t/fun/xkcd/comics/2130/2137/text_entry.png\tgopher.floodgap.com\t70"
  39          "1Test server\t\tlocalhost\t70"
  40          ".")
  41    "\r\n"))
  42
  43
  44 ;;; Customization group
  45 ;;
  46
  47 (defgroup elopher nil
  48   "A simple gopher client."
  49   :group 'applications)
  50
  51 (defcustom elopher-index-face '(foreground-color . "cyan")
  52   "Face used for index records.")
  53 (defcustom elopher-text-face '(foreground-color . "white")
  54   "Face used for text records.")
  55 (defcustom elopher-info-face '(foreground-color . "gray")
  56   "Face used for info records.")
  57 (defcustom elopher-image-face '(foreground-color . "green")
  58   "Face used for image records.")
  59 (defcustom elopher-unknown-face '(foreground-color . "red")
  60   "Face used for unknown record types.")
  61
  62 ;;; Model
  63 ;;
  64
  65 ;; Address
  66
  67 (defun elopher-make-address (selector host port)
  68   (list selector host port))
  69
  70 (defun elopher-address-selector (address)
  71   (car address))
  72
  73 (defun elopher-address-host (address)
  74   (cadr address))
  75
  76 (defun elopher-address-port (address)
  77   (caddr address))
  78
  79 ;; Node
  80
  81 (defun elopher-make-node (parent address getter &optional content pos)
  82   (list parent address getter content pos))
  83
  84 (defun elopher-node-parent (node)
  85   (elt node 0))
  86
  87 (defun elopher-node-address (node)
  88   (elt node 1))
  89
  90 (defun elopher-node-getter (node)
  91   (elt node 2))
  92
  93 (defun elopher-node-content (node)
  94   (elt node 3))
  95
  96 (defun elopher-node-pos (node)
  97   (elt node 4))
  98
  99 (defun elopher-set-node-content (node content)
 100   (setcar (nthcdr 3 node) content))
 101
 102 (defun elopher-set-node-pos (node pos)
 103   (setcar (nthcdr 4 node) pos))
 104
 105 (defun elopher-save-pos ()
 106   (when elopher-current-node
 107     (elopher-set-node-pos elopher-current-node (point))))
 108
 109 (defun elopher-restore-pos ()
 110   (let ((pos (elopher-node-pos elopher-current-node)))
 111     (if pos
 112         (goto-char pos)
 113       (goto-char (point-min)))))
 114
 115 ;; Node graph traversal
 116
 117 (defvar elopher-current-node)
 118
 119 (defun elopher-visit-node (node)
 120   (elopher-save-pos)
 121   (elopher-prepare-buffer)
 122   (setq elopher-current-node node)
 123   (funcall (elopher-node-getter node)))
 124
 125 (defun elopher-visit-parent-node ()
 126   (let ((parent-node (elopher-node-parent elopher-current-node)))
 127     (when parent-node
 128       (elopher-visit-node parent-node))))
 129
 130 (defun elopher-reload-current-node ()
 131   (elopher-set-node-content elopher-current-node nil)
 132   (elopher-visit-node elopher-current-node))
 133
 134
 135 ;;; Buffer preparation
 136 ;;
 137
 138 (defun elopher-prepare-buffer ()
 139   (switch-to-buffer "*elopher*")
 140   (elopher-mode)
 141   (let ((inhibit-read-only t))
 142     (erase-buffer)))
 143
 144
 145 ;;; Index rendering
 146 ;;
 147
 148 (defun elopher-insert-index (string)
 149   "Inserts the index corresponding to STRING into the current buffer."
 150   (dolist (line (split-string string "\r\n"))
 151     (unless (string-empty-p line)
 152       (elopher-insert-index-record line))))
 153
 154 (defun elopher-insert-margin (&optional type-name)
 155   "Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
 156   (if type-name
 157       (progn
 158         (insert (format (concat "%" (number-to-string (- elopher-margin-width 1)) "s")
 159                         (concat
 160                          (propertize "[" 'face '(foreground-color . "blue"))
 161                          (propertize type-name 'face '(foreground-color . "white"))
 162                          (propertize "]" 'face '(foreground-color . "blue")))))
 163         (insert " "))
 164     (insert (make-string elopher-margin-width ?\s))))
 165
 166 (defun elopher-insert-index-record (line)
 167   "Inserts the index record corresponding to LINE into the current buffer."
 168   (let* ((type (elt line 0))
 169          (fields (split-string (substring line 1) "\t"))
 170          (display-string (elt fields 0))
 171          (address (elopher-make-address (elt fields 1) (elt fields 2) (elt fields 3)))
 172          (help-string (format "mouse-1, RET: open %s on %s port %s"
 173                               (elopher-address-selector address)
 174                               (elopher-address-host address)
 175                               (elopher-address-port address))))
 176     (pcase type
 177       (?i (elopher-insert-margin)
 178           (insert (propertize display-string
 179                               'face elopher-info-face)))
 180       (?0 (elopher-insert-margin "T")
 181           (insert-text-button display-string
 182                               'face elopher-text-face
 183                               'elopher-node (elopher-make-node elopher-current-node
 184                                                                address
 185                                                                #'elopher-get-text-node)
 186                               'action #'elopher-click-link
 187                               'follow-link t
 188                               'help-echo help-string))
 189       (?1 (elopher-insert-margin "/")
 190           (insert-text-button display-string
 191                               'face elopher-index-face
 192                               'elopher-node (elopher-make-node elopher-current-node
 193                                                                address
 194                                                                #'elopher-get-index-node)
 195                               'action #'elopher-click-link
 196                               'follow-link t
 197                               'help-echo help-string))
 198       (?p (elopher-insert-margin "im")
 199           (insert-text-button display-string
 200                               'face elopher-image-face
 201                               'elopher-node (elopher-make-node elopher-current-node
 202                                                                address
 203                                                                #'elopher-get-image-node)
 204                               'action #'elopher-click-link
 205                               'follow-link t
 206                               'help-echo help-string))
 207       (?.) ; Occurs at end of index, can safely ignore.
 208       (tp (elopher-insert-margin (concat (char-to-string tp) "?"))
 209           (insert (propertize display-string
 210                               'face elopher-unknown-face))))
 211     (insert "\n")))
 212
 213
 214 ;;; Selector retrieval (all kinds)
 215 ;;
 216
 217 (defvar elopher-selector-string)
 218
 219 (defun elopher-get-selector (address after &optional binary)
 220   "Retrieve selector specified by ADDRESS and store it in the
 221 string elopher-selector-string, then execute AFTER as the
 222 sentinal function.
 223
 224 If BINARY is non-nil, the selector is expected to return a
 225 binary result, otherwise otherwise utf-8 is assumed."
 226   (setq elopher-selector-string "")
 227   (let ((p (get-process "elopher-process")))
 228     (if p (delete-process p)))
 229   (make-network-process
 230    :name "elopher-process"
 231    :host (elopher-address-host address)
 232    :service (elopher-address-port address)
 233    :coding (if binary
 234                '(utf-8 . binary)
 235              '(utf-8 . utf-8))
 236    :filter (lambda (proc string)
 237              (setq elopher-selector-string (concat elopher-selector-string string)))
 238    :sentinel after)
 239   (process-send-string "elopher-process"
 240                        (concat (elopher-address-selector address) "\n")))
 241
 242 ;; Index retrieval
 243
 244 (defun elopher-get-index-node ()
 245   (let ((content (elopher-node-content elopher-current-node))
 246         (address (elopher-node-address elopher-current-node)))
 247     (if content
 248         (progn
 249           (let ((inhibit-read-only t))
 250             (insert content))
 251           (elopher-restore-pos))
 252       (if address
 253           (elopher-get-selector address
 254                                 (lambda (proc event)
 255                                   (let ((inhibit-read-only t))
 256                                     (elopher-insert-index elopher-selector-string))
 257                                   (elopher-restore-pos)
 258                                   (elopher-set-node-content elopher-current-node
 259                                                             (buffer-string))))
 260         (progn
 261           (let ((inhibit-read-only t))
 262             (elopher-insert-index elopher-start-index))
 263           (elopher-restore-pos)
 264           (elopher-set-node-content elopher-current-node
 265                                     (buffer-string)))))))
 266
 267 ;; Text retrieval
 268
 269 (defun elopher-strip-CRs (string)
 270   (replace-regexp-in-string "\r" "" string))
 271
 272 (defun elopher-get-text-node ()
 273   (let ((content (elopher-node-content elopher-current-node))
 274         (address (elopher-node-address elopher-current-node)))
 275     (if content
 276         (progn
 277           (let ((inhibit-read-only t))
 278             (insert content))
 279           (elopher-restore-pos))
 280       (elopher-get-selector address
 281                             (lambda (proc event)
 282                               (let ((inhibit-read-only t))
 283                                 (insert (elopher-strip-CRs elopher-selector-string)))
 284                               (elopher-restore-pos)
 285                               (elopher-set-node-content elopher-current-node
 286                                                         (buffer-string)))))))
 287
 288 ;; Image retrieval
 289
 290 (defun elopher-get-image-node ()
 291   (let ((content (elopher-node-content elopher-current-node))
 292         (address (elopher-node-address elopher-current-node)))
 293     (if content
 294         (progn
 295           (let ((inhibit-read-only t))
 296             (insert-image content))
 297           (elopher-restore-pos))
 298       (elopher-get-selector address
 299                             (lambda (proc event)
 300                               (let ((image (create-image elopher-selector-string))
 301                                     (inhibit-read-only t))
 302                                 (insert-image image)
 303                                 (elopher-restore-pos)
 304                                 (elopher-set-node-content image)))
 305                             'binary))))
 306
 307
 308
 309 ;;; Navigation procedures
 310 ;;
 311
 312 (defun elopher-next-link ()
 313   (interactive)
 314   (forward-button 1))
 315
 316 (defun elopher-prev-link ()
 317   (interactive)
 318   (backward-button 1))
 319
 320 (defun elopher-click-link (button)
 321   (let ((node (button-get button 'elopher-node)))
 322     (elopher-visit-node node)))
 323
 324 (defun elopher-follow-closest-link ()
 325   (interactive)
 326   (push-button))
 327
 328 (defun elopher-go ()
 329   "Go to a particular gopher site."
 330   (interactive)
 331   (let* ((selector "")
 332          (hostname (read-from-minibuffer "Gopher host: "))
 333          (port 70)
 334          (address (list selector hostname port)))
 335     (elopher-visit-node
 336      (elopher-make-node elopher-current-node
 337                         address
 338                         #'elopher-get-index-node))))
 339
 340 (defun  elopher-reload ()
 341   "Reload current site."
 342   (interactive)
 343   (elopher-reload-current-node))
 344
 345 (defun elopher-back ()
 346   "Go to previous site."
 347   (interactive)
 348   (if (elopher-node-parent elopher-current-node)
 349       (elopher-visit-parent-node)
 350     (message "No previous site.")))
 351
 352
 353 ;;; Mode and keymap
 354 ;;
 355
 356 (defvar elopher-mode-map
 357   (let ((map (make-sparse-keymap)))
 358     (define-key map (kbd "<tab>") 'elopher-next-link)
 359     (define-key map (kbd "<S-tab>") 'elopher-prev-link)
 360     (define-key map (kbd "u") 'elopher-back)
 361     (define-key map (kbd "g") 'elopher-go)
 362     (define-key map (kbd "r") 'elopher-reload)
 363     (when (require 'evil nil t)
 364       (evil-define-key 'normal map
 365         (kbd "C-]") 'elopher-follow-closest-link
 366         (kbd "C-t") 'elopher-back
 367         (kbd "u") 'elopher-back
 368         (kbd "g") 'elopher-go
 369         (kbd "r") 'elopher-reload))
 370     map)
 371   "Keymap for gopher client.")
 372
 373 (define-derived-mode elopher-mode special-mode "elopher"
 374   "Major mode for elopher, an elisp gopher client.")
 375
 376
 377 ;;; Main start procedure
 378 ;;
 379 (defun elopher ()
 380   "Start elopher with default landing page."
 381   (interactive)
 382   (setq elopher-current-node nil)
 383   (let ((start-node (elopher-make-node nil nil #'elopher-get-index-node)))
 384     (elopher-visit-node start-node)))
 385
 386 ;;; elopher.el ends here