1 ;;; elopher.el --- elisp gopher client
5 ;; An elisp gopher client.
12 (defconst elopher-version "1.0.0"
13 "Current version of elopher.")
15 (defconst elopher-margin-width 6
16 "Width of left-hand margin used when rendering indicies.")
18 (defconst elopher-start-index
21 (list "i\tfake\tfake\t1"
22 "i--------------------------------------------\tfake\tfake\t1"
23 "i Elopher Gopher Client \tfake\tfake\t1"
24 (format "i version %s\tfake\tfake\t1" elopher-version)
25 "i--------------------------------------------\tfake\tfake\t1"
27 "iBasic usage:\tfake\tfake\t1"
29 "i - tab/shift-tab: next/prev directory entry on current page\tfake\tfake\t1"
30 "i - RET/mouse-1: open directory entry under cursor\tfake\tfake\t1"
31 "i - u: return to parent directory entry\tfake\tfake\t1"
32 "i - g: go to a particular page\tfake\tfake\t1"
33 "i - r: reload current page\tfake\tfake\t1"
34 "i - d: download directory entry under cursor\tfake\tfake\t1"
35 "i - w: display the raw server response for the current page\tfake\tfake\t1"
37 "iPlaces to start exploring Gopherspace:\tfake\tfake\t1"
39 "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70"
41 "iAlternatively, select the following item and enter some\tfake\tfake\t1"
42 "isearch terms:\tfake\tfake\t1"
44 "7Veronica-2 Gopher Search Engine\t/v2/vs\tgopher.floodgap.com\t70"
47 "Source for elopher start page.")
50 ;;; Customization group
57 (defface elopher-index
58 '((((background dark)) :foreground "deep sky blue")
59 (((background light)) :foreground "blue"))
60 "Face used for index records.")
63 '((((background dark)) :foreground "white")
64 (((background light)) :weight bold))
65 "Face used for text records.")
67 (defface elopher-info '()
68 "Face used for info records.")
70 (defface elopher-image
71 '((((background dark)) :foreground "green")
72 (t :foreground "dark green"))
73 "Face used for image records.")
75 (defface elopher-search
76 '((((background light)) :foreground "orange")
77 (((background dark)) :foreground "dark orange"))
78 "Face used for search records.")
81 '((((background dark)) :foreground "yellow")
82 (((background light)) :foreground "dark red"))
83 "Face used for url records.")
85 (defface elopher-binary
86 '((t :foreground "magenta"))
87 "Face used for binary records.")
89 (defface elopher-unknown
90 '((t :foreground "red"))
91 "Face used for unknown record types.")
93 (defface elopher-margin-key
94 '((((background dark)) :foreground "white"))
95 "Face used for margin key.")
97 (defface elopher-margin-brackets
98 '((t :foreground "blue"))
99 "Face used for brackets around margin key.")
101 (defcustom elopher-open-urls-with-eww nil
102 "If non-nil, open URL selectors using eww.
103 Otherwise, use the system browser via the BROWSE-URL function."
111 (defun elopher-make-address (selector host port)
112 (list selector host port))
114 (defun elopher-address-selector (address)
117 (defun elopher-address-host (address)
120 (defun elopher-address-port (address)
125 (defun elopher-make-node (parent address getter &optional content pos)
126 (list parent address getter content pos))
128 (defun elopher-node-parent (node)
131 (defun elopher-node-address (node)
134 (defun elopher-node-getter (node)
137 (defun elopher-node-content (node)
140 (defun elopher-node-pos (node)
143 (defun elopher-set-node-content (node content)
144 (setcar (nthcdr 3 node) content))
146 (defun elopher-set-node-pos (node pos)
147 (setcar (nthcdr 4 node) pos))
149 (defun elopher-save-pos ()
150 (when elopher-current-node
151 (elopher-set-node-pos elopher-current-node (point))))
153 (defun elopher-restore-pos ()
154 (let ((pos (elopher-node-pos elopher-current-node)))
157 (goto-char (point-min)))))
159 ;; Node graph traversal
161 (defvar elopher-current-node)
163 (defun elopher-visit-node (node &optional getter)
165 (elopher-process-cleanup)
166 (setq elopher-current-node node)
169 (funcall (elopher-node-getter node))))
171 (defun elopher-visit-parent-node ()
172 (let ((parent-node (elopher-node-parent elopher-current-node)))
174 (elopher-visit-node parent-node))))
176 (defun elopher-reload-current-node ()
177 (elopher-set-node-content elopher-current-node nil)
178 (elopher-visit-node elopher-current-node))
180 ;;; Buffer preparation
183 (defmacro elopher-with-clean-buffer (&rest args)
184 "Evaluate ARGS with a clean *elopher* buffer as current."
186 '(switch-to-buffer "*elopher*")
188 (append (list 'let '((inhibit-read-only t))
195 (defun elopher-insert-index (string)
196 "Insert the index corresponding to STRING into the current buffer."
197 (dolist (line (split-string string "\r\n"))
198 (unless (= (length line) 0)
199 (elopher-insert-index-record line))))
201 (defun elopher-insert-margin (&optional type-name)
202 "Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
205 (insert (format (concat "%" (number-to-string (- elopher-margin-width 1)) "s")
207 (propertize "[" 'face 'elopher-margin-brackets)
208 (propertize type-name 'face 'elopher-margin-key)
209 (propertize "]" 'face 'elopher-margin-brackets))))
211 (insert (make-string elopher-margin-width ?\s))))
213 (defvar elopher-type-map
214 '((?0 elopher-get-text-node "T" elopher-text)
215 (?1 elopher-get-index-node "/" elopher-index)
216 (?g elopher-get-image-node "im" elopher-image)
217 (?p elopher-get-image-node "im" elopher-image)
218 (?I elopher-get-image-node "im" elopher-image)
219 (?4 elopher-get-node-download "B" elopher-binary)
220 (?5 elopher-get-node-download "B" elopher-binary)
221 (?9 elopher-get-node-download "B" elopher-binary)
222 (?7 elopher-get-search-node "?" elopher-search))
223 "Association list from types to getters, margin codes and index faces.")
225 (defun elopher-insert-index-record (line)
226 "Insert the index record corresponding to LINE into the current buffer."
227 (let* ((type (elt line 0))
228 (fields (split-string (substring line 1) "\t"))
229 (display-string (elt fields 0))
230 (selector (elt fields 1))
231 (host (elt fields 2))
232 (port (elt fields 3))
233 (address (elopher-make-address selector host port))
234 (type-map-entry (alist-get type elopher-type-map)))
236 (let ((getter (car type-map-entry))
237 (margin-code (cadr type-map-entry))
238 (face (caddr type-map-entry)))
239 (elopher-insert-margin margin-code)
240 (insert-text-button display-string
242 'elopher-node (elopher-make-node elopher-current-node
245 'action #'elopher-click-link
247 'help-echo (format "mouse-1, RET: open %s on %s port %s"
248 selector host port)))
250 (?i (elopher-insert-margin) ; Information
251 (insert (propertize display-string
252 'face 'elopher-info)))
253 (?h (elopher-insert-margin "W") ; Web link
254 (let ((url (elt (split-string selector "URL:") 1)))
255 (insert-text-button display-string
258 'action #'elopher-click-url
260 'help-echo (format "mouse-1, RET: open url %s" url))))
261 (?.) ; Occurs at end of index, can safely ignore.
262 (tp (elopher-insert-margin (concat (char-to-string tp) "?"))
263 (insert (propertize display-string
264 'face elopher-unknown-face)))))
268 ;;; Selector retrieval (all kinds)
271 (defun elopher-process-cleanup ()
272 "Immediately shut down any extant elopher process."
273 (let ((p (get-process "elopher-process")))
274 (if p (delete-process p))))
276 (defvar elopher-selector-string)
278 (defun elopher-get-selector (address after)
279 "Retrieve selector specified by ADDRESS, then execute AFTER.
280 The result is stored as a string in the variable elopher-selector-string."
281 (setq elopher-selector-string "")
282 (make-network-process
283 :name "elopher-process"
284 :host (elopher-address-host address)
285 :service (elopher-address-port address)
286 :filter (lambda (proc string)
287 (setq elopher-selector-string (concat elopher-selector-string string)))
289 (process-send-string "elopher-process"
290 (concat (elopher-address-selector address) "\n")))
294 (defun elopher-get-index-node ()
295 (let ((content (elopher-node-content elopher-current-node))
296 (address (elopher-node-address elopher-current-node)))
299 (elopher-with-clean-buffer
301 (elopher-restore-pos))
304 (elopher-with-clean-buffer
305 (insert "LOADING DIRECTORY..."))
306 (elopher-get-selector address
308 (unless (string-prefix-p "deleted" event)
309 (elopher-with-clean-buffer
310 (elopher-insert-index elopher-selector-string))
311 (elopher-restore-pos)
312 (elopher-set-node-content elopher-current-node
315 (elopher-with-clean-buffer
316 (elopher-insert-index elopher-start-index))
317 (elopher-restore-pos)
318 (elopher-set-node-content elopher-current-node
319 (buffer-string)))))))
323 (defconst elopher-url-regex "\\(https?\\|gopher\\)://\\([a-zA-Z0-9.\-]+\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?"
324 "Regexp used to locate and buttinofy URLs in text files loaded by elopher.")
326 (defun elopher-buttonify-urls (string)
327 "Turn substrings which look like urls in STRING into clickable buttons."
330 (goto-char (point-min))
331 (while (re-search-forward elopher-url-regex nil t)
332 (let ((url (match-string 0))
333 (protocol (downcase (match-string 1))))
334 (if (string= protocol "gopher")
335 (let* ((host (match-string 2))
337 (type-and-selector (match-string 4))
338 (type (if (> (length type-and-selector) 1)
339 (elt type-and-selector 1)
341 (selector (if (> (length type-and-selector) 1)
342 (substring type-and-selector 2)
344 (address (elopher-make-address selector host port))
345 (getter (car (alist-get type elopher-type-map))))
346 (make-text-button (match-beginning 0)
348 'elopher-node (elopher-make-node elopher-current-node
351 'action #'elopher-click-link
353 'help-echo (format "mouse-1, RET: open %s on %s port %s"
354 selector host port)))
355 (make-text-button (match-beginning 0)
358 'action #'elopher-click-url
360 'help-echo (format "mouse-1, RET: open url %s" url)))))
363 (defun elopher-process-text (string)
364 (let* ((chopped-str (replace-regexp-in-string "\r\n\.\r\n$" "\r\n" string))
365 (cleaned-str (replace-regexp-in-string "\r" "" chopped-str)))
366 (elopher-buttonify-urls cleaned-str)))
368 (defun elopher-get-text-node ()
369 (let ((content (elopher-node-content elopher-current-node))
370 (address (elopher-node-address elopher-current-node)))
373 (elopher-with-clean-buffer
375 (elopher-restore-pos))
377 (elopher-with-clean-buffer
378 (insert "LOADING TEXT..."))
379 (elopher-get-selector address
381 (unless (string-prefix-p "deleted" event)
382 (elopher-with-clean-buffer
383 (insert (elopher-process-text elopher-selector-string)))
384 (elopher-restore-pos)
385 (elopher-set-node-content elopher-current-node
386 (buffer-string)))))))))
390 (defun elopher-get-image-node ()
391 (let ((content (elopher-node-content elopher-current-node))
392 (address (elopher-node-address elopher-current-node)))
395 (elopher-with-clean-buffer
396 (insert-image content))
397 (setq cursor-type nil)
398 (elopher-restore-pos))
400 (elopher-with-clean-buffer
401 (insert "LOADING IMAGE..."))
402 (elopher-get-selector address
404 (unless (string-prefix-p "deleted" event)
405 (let ((image (create-image
406 (string-as-unibyte elopher-selector-string)
408 (elopher-with-clean-buffer
409 (insert-image image))
410 (setq cursor-type nil)
411 (elopher-restore-pos)
412 (elopher-set-node-content elopher-current-node
417 (defun elopher-get-search-node ()
418 (let ((content (elopher-node-content elopher-current-node))
419 (address (elopher-node-address elopher-current-node))
423 (elopher-with-clean-buffer
425 (elopher-restore-pos)
426 (message "Displaying cached search results. Reload to perform a new search."))
428 (let* ((query-string (read-string "Query: "))
429 (query-selector (concat (elopher-address-selector address) "\t" query-string))
430 (search-address (elopher-make-address query-selector
431 (elopher-address-host address)
432 (elopher-address-port address))))
434 (elopher-with-clean-buffer
435 (insert "LOADING RESULTS..."))
436 (elopher-get-selector search-address
438 (unless (string-prefix-p "deleted" event)
439 (elopher-with-clean-buffer
440 (elopher-insert-index elopher-selector-string))
441 (goto-char (point-min))
442 (elopher-set-node-content elopher-current-node
445 (elopher-visit-parent-node))))))
447 ;; Raw server response retrieval
449 (defun elopher-get-node-raw ()
450 (let* ((content (elopher-node-content elopher-current-node))
451 (address (elopher-node-address elopher-current-node)))
452 (elopher-with-clean-buffer
453 (insert "LOADING RAW SERVER RESPONSE..."))
455 (elopher-get-selector address
457 (unless (string-prefix-p "deleted" event)
458 (elopher-with-clean-buffer
459 (insert elopher-selector-string))
460 (goto-char (point-min)))))
462 (elopher-with-clean-buffer
463 (insert elopher-start-index))
464 (goto-char (point-min)))))
465 (message "Displaying raw server response. Reload to return to standard view."))
467 ;; File export retrieval
469 (defvar elopher-download-filename)
471 (defun elopher-get-node-download ()
472 (let* ((address (elopher-node-address elopher-current-node))
473 (selector (elopher-address-selector address)))
474 (elopher-visit-parent-node) ; Do first in case of non-local exits.
475 (let* ((filename-proposal (file-name-nondirectory selector))
476 (filename (read-file-name "Save file as: "
478 (if (> (length filename-proposal) 0)
481 (message "Downloading...")
482 (setq elopher-download-filename filename)
483 (elopher-get-selector address
485 (let ((coding-system-for-write 'binary))
486 (with-temp-file elopher-download-filename
487 (insert elopher-selector-string)
488 (message (format "Download complate, saved to file %s."
489 elopher-download-filename)))))))))
492 ;;; Navigation procedures
495 (defun elopher-next-link ()
499 (defun elopher-prev-link ()
503 (defun elopher-click-link (button)
504 (let ((node (button-get button 'elopher-node)))
505 (elopher-visit-node node)))
507 (defun elopher-click-url (button)
508 (let ((url (button-get button 'elopher-url)))
509 (if elopher-open-urls-with-eww
513 (defun elopher-follow-closest-link ()
518 "Go to a particular gopher site."
521 (hostname (read-string "Gopher host: "))
522 (selector (read-string "Selector (default none): " nil nil ""))
523 (port (read-string "Port (default 70): " nil nil 70))
524 (address (list selector hostname port)))
526 (elopher-make-node elopher-current-node
528 #'elopher-get-index-node))))
530 (defun elopher-reload ()
531 "Reload current page."
533 (elopher-reload-current-node))
535 (defun elopher-view-raw ()
536 "View current page as plain text."
538 (elopher-visit-node elopher-current-node
539 #'elopher-get-node-raw))
541 (defun elopher-back ()
542 "Go to previous site."
544 (if (elopher-node-parent elopher-current-node)
545 (elopher-visit-parent-node)
546 (message "No previous site.")))
548 (defun elopher-download ()
549 "Download the link at point."
551 (let ((button (button-at (point))))
553 (let ((node (button-get button 'elopher-node)))
555 (elopher-visit-node (button-get button 'elopher-node)
556 #'elopher-get-node-download)
557 (message "Can only download gopher links, not general URLs.")))
558 (message "No link selected."))))
563 (defvar elopher-mode-map
564 (let ((map (make-sparse-keymap)))
565 (define-key map (kbd "<tab>") 'elopher-next-link)
566 (define-key map (kbd "<S-tab>") 'elopher-prev-link)
567 (define-key map (kbd "u") 'elopher-back)
568 (define-key map (kbd "g") 'elopher-go)
569 (define-key map (kbd "r") 'elopher-reload)
570 (define-key map (kbd "w") 'elopher-view-raw)
571 (define-key map (kbd "d") 'elopher-download)
572 (when (fboundp 'evil-define-key)
573 (evil-define-key 'normal map
574 (kbd "C-]") 'elopher-follow-closest-link
575 (kbd "C-t") 'elopher-back
576 (kbd "u") 'elopher-back
577 (kbd "g") 'elopher-go
578 (kbd "r") 'elopher-reload
579 (kbd "w") 'elopher-view-raw
580 (kbd "d") 'elopher-download))
582 "Keymap for gopher client.")
584 (define-derived-mode elopher-mode special-mode "elopher"
585 "Major mode for elopher, an elisp gopher client.")
588 ;;; Main start procedure
592 "Start elopher with default landing page."
594 (setq elopher-current-node nil)
595 (let ((start-node (elopher-make-node nil nil #'elopher-get-index-node)))
596 (elopher-visit-node start-node))
597 "Started Elopher.") ; Otherwise (elopher) evaluates to start page string.
599 ;;; elopher.el ends here