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-search-face '(foreground-color . "orange")
  60   "Face used for image records.")
  61 (defcustom elopher-unknown-face '(foreground-color . "red")
  62   "Face used for unknown record types.")
  63
  64 ;;; Model
  65 ;;
  66
  67 ;; Address
  68
  69 (defun elopher-make-address (selector host port)
  70   (list selector host port))
  71
  72 (defun elopher-address-selector (address)
  73   (car address))
  74
  75 (defun elopher-address-host (address)
  76   (cadr address))
  77
  78 (defun elopher-address-port (address)
  79   (caddr address))
  80
  81 ;; Node
  82
  83 (defun elopher-make-node (parent address getter &optional content pos)
  84   (list parent address getter content pos))
  85
  86 (defun elopher-node-parent (node)
  87   (elt node 0))
  88
  89 (defun elopher-node-address (node)
  90   (elt node 1))
  91
  92 (defun elopher-node-getter (node)
  93   (elt node 2))
  94
  95 (defun elopher-node-content (node)
  96   (elt node 3))
  97
  98 (defun elopher-node-pos (node)
  99   (elt node 4))
 100
 101 (defun elopher-set-node-content (node content)
 102   (setcar (nthcdr 3 node) content))
 103
 104 (defun elopher-set-node-pos (node pos)
 105   (setcar (nthcdr 4 node) pos))
 106
 107 (defun elopher-save-pos ()
 108   (when elopher-current-node
 109     (elopher-set-node-pos elopher-current-node (point))))
 110
 111 (defun elopher-restore-pos ()
 112   (let ((pos (elopher-node-pos elopher-current-node)))
 113     (if pos
 114         (goto-char pos)
 115       (goto-char (point-min)))))
 116
 117 ;; Node graph traversal
 118
 119 (defvar elopher-current-node)
 120
 121 (defun elopher-visit-node (node)
 122   (elopher-save-pos)
 123   (elopher-prepare-buffer)
 124   (setq elopher-current-node node)
 125   (funcall (elopher-node-getter node)))
 126
 127 (defun elopher-visit-parent-node ()
 128   (let ((parent-node (elopher-node-parent elopher-current-node)))
 129     (when parent-node
 130       (elopher-visit-node parent-node))))
 131
 132 (defun elopher-reload-current-node ()
 133   (elopher-set-node-content elopher-current-node nil)
 134   (elopher-visit-node elopher-current-node))
 135
 136
 137 ;;; Buffer preparation
 138 ;;
 139
 140 (defun elopher-prepare-buffer ()
 141   (switch-to-buffer "*elopher*")
 142   (elopher-mode)
 143   (let ((inhibit-read-only t))
 144     (erase-buffer)))
 145
 146
 147 ;;; Index rendering
 148 ;;
 149
 150 (defun elopher-insert-index (string)
 151   "Inserts the index corresponding to STRING into the current buffer."
 152   (dolist (line (split-string string "\r\n"))
 153     (unless (string-empty-p line)
 154       (elopher-insert-index-record line))))
 155
 156 (defun elopher-insert-margin (&optional type-name)
 157   "Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
 158   (if type-name
 159       (progn
 160         (insert (format (concat "%" (number-to-string (- elopher-margin-width 1)) "s")
 161                         (concat
 162                          (propertize "[" 'face '(foreground-color . "blue"))
 163                          (propertize type-name 'face '(foreground-color . "white"))
 164                          (propertize "]" 'face '(foreground-color . "blue")))))
 165         (insert " "))
 166     (insert (make-string elopher-margin-width ?\s))))
 167
 168 (defun elopher-insert-index-record (line)
 169   "Inserts the index record corresponding to LINE into the current buffer."
 170   (let* ((type (elt line 0))
 171          (fields (split-string (substring line 1) "\t"))
 172          (display-string (elt fields 0))
 173          (address (elopher-make-address (elt fields 1) (elt fields 2) (elt fields 3)))
 174          (help-string (format "mouse-1, RET: open %s on %s port %s"
 175                               (elopher-address-selector address)
 176                               (elopher-address-host address)
 177                               (elopher-address-port address))))
 178     (pcase type
 179       (?i (elopher-insert-margin)
 180           (insert (propertize display-string
 181                               'face elopher-info-face)))
 182       (?0 (elopher-insert-margin "T")
 183           (insert-text-button display-string
 184                               'face elopher-text-face
 185                               'elopher-node (elopher-make-node elopher-current-node
 186                                                                address
 187                                                                #'elopher-get-text-node)
 188                               'action #'elopher-click-link
 189                               'follow-link t
 190                               'help-echo help-string))
 191       (?1 (elopher-insert-margin "/")
 192           (insert-text-button display-string
 193                               'face elopher-index-face
 194                               'elopher-node (elopher-make-node elopher-current-node
 195                                                                address
 196                                                                #'elopher-get-index-node)
 197                               'action #'elopher-click-link
 198                               'follow-link t
 199                               'help-echo help-string))
 200       ((or ?g ?p ?I) (elopher-insert-margin "im")
 201           (insert-text-button display-string
 202                               'face elopher-image-face
 203                               'elopher-node (elopher-make-node elopher-current-node
 204                                                                address
 205                                                                #'elopher-get-image-node)
 206                               'action #'elopher-click-link
 207                               'follow-link t
 208                               'help-echo help-string))
 209       (?7 (elopher-insert-margin "?")
 210           (insert-text-button display-string
 211                               'face elopher-search-face
 212                               'elopher-node (elopher-make-node elopher-current-node
 213                                                               address
 214                                                               #'elopher-get-search-node)
 215                               'action #'elopher-click-link
 216                               'follow-link t
 217                               'help-echo help-string))
 218       (?.) ; Occurs at end of index, can safely ignore.
 219       (tp (elopher-insert-margin (concat (char-to-string tp) "?"))
 220           (insert (propertize display-string
 221                               'face elopher-unknown-face))))
 222     (insert "\n")))
 223
 224
 225 ;;; Selector retrieval (all kinds)
 226 ;;
 227
 228 (defvar elopher-selector-string)
 229
 230 (defun elopher-get-selector (address after &optional binary)
 231   "Retrieve selector specified by ADDRESS and store it in the
 232 string elopher-selector-string, then execute AFTER as the
 233 sentinal function."
 234   (setq elopher-selector-string "")
 235   (let ((p (get-process "elopher-process")))
 236     (if p (delete-process p)))
 237   (make-network-process
 238    :name "elopher-process"
 239    :host (elopher-address-host address)
 240    :service (elopher-address-port address)
 241    :filter (lambda (proc string)
 242              (setq elopher-selector-string (concat elopher-selector-string string)))
 243    :sentinel after)
 244   (process-send-string "elopher-process"
 245                        (concat (elopher-address-selector address) "\n")))
 246
 247 ;; Index retrieval
 248
 249 (defun elopher-get-index-node ()
 250   (let ((content (elopher-node-content elopher-current-node))
 251         (address (elopher-node-address elopher-current-node)))
 252     (if content
 253         (progn
 254           (let ((inhibit-read-only t))
 255             (insert content))
 256           (elopher-restore-pos))
 257       (if address
 258           (progn
 259             (let ((inhibit-read-only t))
 260               (insert "LOADING DIRECTORY..."))
 261             (elopher-get-selector address
 262                                   (lambda (proc event)
 263                                     (let ((inhibit-read-only t))
 264                                       (erase-buffer)
 265                                       (elopher-insert-index elopher-selector-string))
 266                                     (elopher-restore-pos)
 267                                     (elopher-set-node-content elopher-current-node
 268                                                               (buffer-string)))))
 269         (progn
 270           (let ((inhibit-read-only t))
 271             (elopher-insert-index elopher-start-index))
 272           (elopher-restore-pos)
 273           (elopher-set-node-content elopher-current-node
 274                                     (buffer-string)))))))
 275
 276 ;; Text retrieval
 277
 278 (defun elopher-strip-CRs (string)
 279   (replace-regexp-in-string "\r" "" string))
 280
 281 (defun elopher-get-text-node ()
 282   (let ((content (elopher-node-content elopher-current-node))
 283         (address (elopher-node-address elopher-current-node)))
 284     (if content
 285         (progn
 286           (let ((inhibit-read-only t))
 287             (insert content))
 288           (elopher-restore-pos))
 289       (progn
 290         (let ((inhibit-read-only t))
 291           (insert "LOADING TEXT..."))
 292         (elopher-get-selector address
 293                               (lambda (proc event)
 294                                 (let ((inhibit-read-only t))
 295                                   (erase-buffer)
 296                                   (insert (elopher-strip-CRs elopher-selector-string)))
 297                                 (elopher-restore-pos)
 298                                 (elopher-set-node-content elopher-current-node
 299                                                           (buffer-string))))))))
 300
 301 ;; Image retrieval
 302
 303 (defun elopher-get-image-node ()
 304   (let ((content (elopher-node-content elopher-current-node))
 305         (address (elopher-node-address elopher-current-node)))
 306     (if content
 307         (progn
 308           (let ((inhibit-read-only t))
 309             (insert-image content))
 310           (setq cursor-type nil)
 311           (elopher-restore-pos))
 312       (progn
 313         (let ((inhibit-read-only t))
 314           (insert "LOADING IMAGE..."))
 315         (elopher-get-selector address
 316                               (lambda (proc event)
 317                                 (let ((image (create-image
 318                                               (string-as-unibyte elopher-selector-string)
 319                                               nil t))
 320                                       (inhibit-read-only t))
 321                                   (erase-buffer)
 322                                   (insert-image image)
 323                                   (setq cursor-type nil)
 324                                   (elopher-restore-pos)
 325                                   (elopher-set-node-content elopher-current-node image))))))))
 326
 327 ;; Search retrieval
 328
 329 (defun elopher-get-search-node ()
 330   (let* ((content (elopher-node-content elopher-current-node))
 331          (address (elopher-node-address elopher-current-node))
 332          (search-address (elopher-make-address (concat (elopher-address-selector address)
 333                                                        "\t"
 334                                                        (read-from-minibuffer "Query: "))
 335                                                (elopher-address-host address)
 336                                                (elopher-address-port address))))
 337     (let ((inhibit-read-only t))
 338       (insert "LOADING RESULTS..."))
 339     (elopher-get-selector search-address
 340                           (lambda (proc event)
 341                             (let ((inhibit-read-only t))
 342                               (erase-buffer)
 343                               (elopher-insert-index elopher-selector-string))
 344                             (elopher-restore-pos)
 345                             (elopher-set-node-content elopher-current-node
 346                                                       (buffer-string))))))
 347
 348
 349 ;;; Navigation procedures
 350 ;;
 351
 352 (defun elopher-next-link ()
 353   (interactive)
 354   (forward-button 1))
 355
 356 (defun elopher-prev-link ()
 357   (interactive)
 358   (backward-button 1))
 359
 360 (defun elopher-click-link (button)
 361   (let ((node (button-get button 'elopher-node)))
 362     (elopher-visit-node node)))
 363
 364 (defun elopher-follow-closest-link ()
 365   (interactive)
 366   (push-button))
 367
 368 (defun elopher-go ()
 369   "Go to a particular gopher site."
 370   (interactive)
 371   (let* ((selector "")
 372          (hostname (read-from-minibuffer "Gopher host: "))
 373          (port 70)
 374          (address (list selector hostname port)))
 375     (elopher-visit-node
 376      (elopher-make-node elopher-current-node
 377                         address
 378                         #'elopher-get-index-node))))
 379
 380 (defun  elopher-reload ()
 381   "Reload current site."
 382   (interactive)
 383   (elopher-reload-current-node))
 384
 385 (defun elopher-back ()
 386   "Go to previous site."
 387   (interactive)
 388   (if (elopher-node-parent elopher-current-node)
 389       (elopher-visit-parent-node)
 390     (message "No previous site.")))
 391
 392
 393 ;;; Mode and keymap
 394 ;;
 395
 396 (defvar elopher-mode-map
 397   (let ((map (make-sparse-keymap)))
 398     (define-key map (kbd "<tab>") 'elopher-next-link)
 399     (define-key map (kbd "<S-tab>") 'elopher-prev-link)
 400     (define-key map (kbd "u") 'elopher-back)
 401     (define-key map (kbd "g") 'elopher-go)
 402     (define-key map (kbd "r") 'elopher-reload)
 403     (when (require 'evil nil t)
 404       (evil-define-key 'normal map
 405         (kbd "C-]") 'elopher-follow-closest-link
 406         (kbd "C-t") 'elopher-back
 407         (kbd "u") 'elopher-back
 408         (kbd "g") 'elopher-go
 409         (kbd "r") 'elopher-reload))
 410     map)
 411   "Keymap for gopher client.")
 412
 413 (define-derived-mode elopher-mode special-mode "elopher"
 414   "Major mode for elopher, an elisp gopher client.")
 415
 416
 417 ;;; Main start procedure
 418 ;;
 419 (defun elopher ()
 420   "Start elopher with default landing page."
 421   (interactive)
 422   (setq elopher-current-node nil)
 423   (let ((start-node (elopher-make-node nil nil #'elopher-get-index-node)))
 424     (elopher-visit-node start-node)))
 425
 426 ;;; elopher.el ends here