X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elopher.el;h=959bc688563c8b38d1ef65cd2432f08b0f3182ca;hb=e4a1133e92854a9973e24c6441146c4a406f4a27;hp=c9a63b58ad72b359a08cf19778eb6900088e9df2;hpb=62679752737a28609721478ed0fab221d062c2a2;p=elpher.git diff --git a/elopher.el b/elopher.el index c9a63b5..959bc68 100644 --- a/elopher.el +++ b/elopher.el @@ -15,25 +15,30 @@ (defconst elopher-margin-width 6 "Width of left-hand margin used when rendering indicies.") -(defconst elopher-start-page - (concat "i\tfake\tfake\t1\r\n" - "i--------------------------------------------\tfake\tfake\t1\r\n" - "i Elopher Gopher Client \tfake\tfake\t1\r\n" - (format "i version %s\tfake\tfake\t1\r\n" elopher-version) - "i--------------------------------------------\tfake\tfake\t1\r\n" - "i\tfake\tfake\t1\r\n" - "iBasic usage:\tfake\tfake\t1\r\n" - "i - tab/shift-tab: next/prev directory entry\tfake\tfake\t1\r\n" - "i - RET/mouse-1: open directory entry\tfake\tfake\t1\r\n" - "i - u: return to parent directory entry\tfake\tfake\t1\r\n" - "i - g: go to a particular site\tfake\tfake\t1\r\n" - "i\tfake\tfake\t1\r\n" - "iPlaces to start exploring Gopherspace:\tfake\tfake\t1\r\n" - "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70\r\n" - "1Super-Dimensional Fortress\t\tsdf.org\t70\r\n" - "i\tfake\tfake\t1\r\n" - "iTest entries:\tfake\tfake\t1\r\n" - "pXKCD comic image\t/fun/xkcd/comics/2130/2137/text_entry.png\tgopher.floodgap.com\t70\r\n")) +(defconst elopher-start-index + (string-join + (list "i\tfake\tfake\t1" + "i--------------------------------------------\tfake\tfake\t1" + "i Elopher Gopher Client \tfake\tfake\t1" + (format "i version %s\tfake\tfake\t1" elopher-version) + "i--------------------------------------------\tfake\tfake\t1" + "i\tfake\tfake\t1" + "iBasic usage:\tfake\tfake\t1" + "i - tab/shift-tab: next/prev directory entry\tfake\tfake\t1" + "i - RET/mouse-1: open directory entry\tfake\tfake\t1" + "i - u: return to parent directory entry\tfake\tfake\t1" + "i - g: go to a particular site\tfake\tfake\t1" + "i - r: reload current page\tfake\tfake\t1" + "i\tfake\tfake\t1" + "iPlaces to start exploring Gopherspace:\tfake\tfake\t1" + "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70" + "1Super-Dimensional Fortress\t\tsdf.org\t70" + "i\tfake\tfake\t1" + "iTest entries:\tfake\tfake\t1" + "pXKCD comic image\t/fun/xkcd/comics/2130/2137/text_entry.png\tgopher.floodgap.com\t70" + "1Test server\t\tlocalhost\t70" + ".") + "\r\n")) ;;; Customization group @@ -51,6 +56,8 @@ "Face used for info records.") (defcustom elopher-image-face '(foreground-color . "green") "Face used for image records.") +(defcustom elopher-search-face '(foreground-color . "orange") + "Face used for image records.") (defcustom elopher-unknown-face '(foreground-color . "red") "Face used for unknown record types.") @@ -73,37 +80,58 @@ ;; Node -(defun elopher-make-node (parent address getter &optional content) - (list parent address content)) +(defun elopher-make-node (parent address getter &optional content pos) + (list parent address getter content pos)) (defun elopher-node-parent (node) - (car node)) + (elt node 0)) (defun elopher-node-address (node) - (cadr node)) + (elt node 1)) (defun elopher-node-getter (node) - (caddr node)) + (elt node 2)) (defun elopher-node-content (node) - (cadddr node)) + (elt node 3)) + +(defun elopher-node-pos (node) + (elt node 4)) + +(defun elopher-set-node-content (node content) + (setcar (nthcdr 3 node) content)) + +(defun elopher-set-node-pos (node pos) + (setcar (nthcdr 4 node) pos)) + +(defun elopher-save-pos () + (when elopher-current-node + (elopher-set-node-pos elopher-current-node (point)))) -(defvar elopher-start-node (elopher-make-node nil nil #'elopher-index-getter)) -(defvar elopher-current-node elopher-start-node) +(defun elopher-restore-pos () + (let ((pos (elopher-node-pos elopher-current-node))) + (if pos + (goto-char pos) + (goto-char (point-min))))) -(defun elopher-set-current-node-content (content) - (setcar (elopher-node-content elopher-current-node) - content)) +;; Node graph traversal + +(defvar elopher-current-node) (defun elopher-visit-node (node) + (elopher-save-pos) (elopher-prepare-buffer) (setq elopher-current-node node) - (funcall (elopher-node-getter))) + (funcall (elopher-node-getter node))) +(defun elopher-visit-parent-node () + (let ((parent-node (elopher-node-parent elopher-current-node))) + (when parent-node + (elopher-visit-node parent-node)))) + (defun elopher-reload-current-node () - (elopher-prepare-buffer) - (elopher-set-current-node-content nil) - (funcall (elopher-node-getter))) + (elopher-set-node-content elopher-current-node nil) + (elopher-visit-node elopher-current-node)) ;;; Buffer preparation @@ -111,7 +139,9 @@ (defun elopher-prepare-buffer () (switch-to-buffer "*elopher*") - (elopher-mode)) + (elopher-mode) + (let ((inhibit-read-only t)) + (erase-buffer))) ;;; Index rendering @@ -120,15 +150,19 @@ (defun elopher-insert-index (string) "Inserts the index corresponding to STRING into the current buffer." (dolist (line (split-string string "\r\n")) - (elopher-insert-index-record line))) + (unless (string-empty-p line) + (elopher-insert-index-record line)))) (defun elopher-insert-margin (&optional type-name) + "Insert index margin, optionally containing the TYPE-NAME, into the current buffer." (if type-name - (insert (format (concat "%" (number-to-string elopher-margin-width) "s" - (concat - (propertize "[" 'face '(foreground-color . "blue")) - (propertize type-name 'face '(foreground-color . "white")) - (propertize "]" 'face '(foreground-color . "blue")))))) + (progn + (insert (format (concat "%" (number-to-string (- elopher-margin-width 1)) "s") + (concat + (propertize "[" 'face '(foreground-color . "blue")) + (propertize type-name 'face '(foreground-color . "white")) + (propertize "]" 'face '(foreground-color . "blue"))))) + (insert " ")) (insert (make-string elopher-margin-width ?\s)))) (defun elopher-insert-index-record (line) @@ -136,7 +170,11 @@ (let* ((type (elt line 0)) (fields (split-string (substring line 1) "\t")) (display-string (elt fields 0)) - (address (elopher-make-address (elt fields 1) (elt fields 2) (elt fields 3)))) + (address (elopher-make-address (elt fields 1) (elt fields 2) (elt fields 3))) + (help-string (format "mouse-1, RET: open %s on %s port %s" + (elopher-address-selector address) + (elopher-address-host address) + (elopher-address-port address)))) (pcase type (?i (elopher-insert-margin) (insert (propertize display-string @@ -148,7 +186,8 @@ address #'elopher-get-text-node) 'action #'elopher-click-link - 'follow-link t)) + 'follow-link t + 'help-echo help-string)) (?1 (elopher-insert-margin "/") (insert-text-button display-string 'face elopher-index-face @@ -156,7 +195,26 @@ address #'elopher-get-index-node) 'action #'elopher-click-link - 'follow-link t)) + 'follow-link t + 'help-echo help-string)) + ((or ?g ?p ?I) (elopher-insert-margin "im") + (insert-text-button display-string + 'face elopher-image-face + 'elopher-node (elopher-make-node elopher-current-node + address + #'elopher-get-image-node) + 'action #'elopher-click-link + 'follow-link t + 'help-echo help-string)) + (?7 (elopher-insert-margin "?") + (insert-text-button display-string + 'face elopher-search-face + 'elopher-node (elopher-make-node elopher-current-node + address + #'elopher-get-search-node) + 'action #'elopher-click-link + 'follow-link t + 'help-echo help-string)) (?.) ; Occurs at end of index, can safely ignore. (tp (elopher-insert-margin (concat (char-to-string tp) "?")) (insert (propertize display-string @@ -169,7 +227,10 @@ (defvar elopher-selector-string) -(defun elopher-get-selector (address after) +(defun elopher-get-selector (address after &optional binary) + "Retrieve selector specified by ADDRESS and store it in the +string elopher-selector-string, then execute AFTER as the +sentinal function." (setq elopher-selector-string "") (let ((p (get-process "elopher-process"))) (if p (delete-process p))) @@ -186,33 +247,112 @@ ;; Index retrieval (defun elopher-get-index-node () - (let ((content (elopher-node-content elopher-node-current)) - (address (elopher-node-address elopher-node-current))) + (let ((content (elopher-node-content elopher-current-node)) + (address (elopher-node-address elopher-current-node))) (if content - (insert content) + (progn + (let ((inhibit-read-only t)) + (insert content)) + (elopher-restore-pos)) (if address - (elopher-get-selector address - (lambda (proc event) - (let ((inhibit-read-only t)) - (elopher-insert-index elopher-selector-string)) - (elopher-set-current-node-content (buffer-string)))) - (elopher-insert-index elopher-start-page))))) + (progn + (let ((inhibit-read-only t)) + (insert "LOADING DIRECTORY...")) + (elopher-get-selector address + (lambda (proc event) + (let ((inhibit-read-only t)) + (erase-buffer) + (elopher-insert-index elopher-selector-string)) + (elopher-restore-pos) + (elopher-set-node-content elopher-current-node + (buffer-string))))) + (progn + (let ((inhibit-read-only t)) + (elopher-insert-index elopher-start-index)) + (elopher-restore-pos) + (elopher-set-node-content elopher-current-node + (buffer-string))))))) ;; Text retrieval +(defun elopher-strip-CRs (string) + (replace-regexp-in-string "\r" "" string)) + (defun elopher-get-text-node () (let ((content (elopher-node-content elopher-current-node)) (address (elopher-node-address elopher-current-node))) (if content + (progn + (let ((inhibit-read-only t)) + (insert content)) + (elopher-restore-pos)) + (progn (let ((inhibit-read-only t)) - (insert content)) - (elopher-get-selector address - (lambda (proc event) - (let ((inhibit-read-only t)) - (insert elopher-selector-string)) - (elopher-set-current-node-content elopher-selector-string)))))) - -;;; Navigation methods + (insert "LOADING TEXT...")) + (elopher-get-selector address + (lambda (proc event) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (elopher-strip-CRs elopher-selector-string))) + (elopher-restore-pos) + (elopher-set-node-content elopher-current-node + (buffer-string)))))))) + +;; Image retrieval + +(defun elopher-get-image-node () + (let ((content (elopher-node-content elopher-current-node)) + (address (elopher-node-address elopher-current-node))) + (if content + (progn + (let ((inhibit-read-only t)) + (insert-image content)) + (setq cursor-type nil) + (elopher-restore-pos)) + (progn + (let ((inhibit-read-only t)) + (insert "LOADING IMAGE...")) + (elopher-get-selector address + (lambda (proc event) + (let ((image (create-image + (string-as-unibyte elopher-selector-string) + nil t)) + (inhibit-read-only t)) + (erase-buffer) + (insert-image image) + (setq cursor-type nil) + (elopher-restore-pos) + (elopher-set-node-content elopher-current-node image)))))))) + +;; Search retrieval + +(defun elopher-get-search-node () + (let* ((content (elopher-node-content elopher-current-node)) + (address (elopher-node-address elopher-current-node))) + (if content + (progn + (let ((inhibit-read-only t)) + (insert content)) + (elopher-restore-pos) + (message "Displaying cached search results. Reload to perform a new search.")) + (let* ((inhibit-read-only t) + (query-string (read-from-minibuffer "Query: ")) + (query-selector (concat (elopher-address-selector address) "\t" query-string)) + (search-address (elopher-make-address query-selector + (elopher-address-host address) + (elopher-address-port address)))) + (insert "LOADING RESULTS...") + (elopher-get-selector search-address + (lambda (proc event) + (let ((inhibit-read-only t)) + (erase-buffer) + (elopher-insert-index elopher-selector-string)) + (goto-char (point-min)) + (elopher-set-node-content elopher-current-node + (buffer-string)))))))) + + +;;; Navigation procedures ;; (defun elopher-next-link () @@ -241,44 +381,52 @@ (elopher-visit-node (elopher-make-node elopher-current-node address - #'elopher-index-getter)))) + #'elopher-get-index-node)))) (defun elopher-reload () "Reload current site." (interactive) (elopher-reload-current-node)) - -;;; Main start procedure -;; -(defun elopher () - "Start elopher with default landing page." +(defun elopher-back () + "Go to previous site." (interactive) - (elopher-visit-node elopher-start-node)) + (if (elopher-node-parent elopher-current-node) + (elopher-visit-parent-node) + (message "No previous site."))) ;;; Mode and keymap ;; -(setq elopher-mode-map +(defvar elopher-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "") 'elopher-next-link) (define-key map (kbd "") 'elopher-prev-link) - (define-key map (kbd "u") 'elopher-pop-history) + (define-key map (kbd "u") 'elopher-back) (define-key map (kbd "g") 'elopher-go) (define-key map (kbd "r") 'elopher-reload) (when (require 'evil nil t) (evil-define-key 'normal map (kbd "C-]") 'elopher-follow-closest-link - (kbd "C-t") 'elopher-pop-history - (kbd "u") 'elopher-pop-history + (kbd "C-t") 'elopher-back + (kbd "u") 'elopher-back (kbd "g") 'elopher-go (kbd "r") 'elopher-reload)) - map)) - ;; "Keymap for gopher client.") + map) + "Keymap for gopher client.") (define-derived-mode elopher-mode special-mode "elopher" "Major mode for elopher, an elisp gopher client.") +;;; Main start procedure +;; +(defun elopher () + "Start elopher with default landing page." + (interactive) + (setq elopher-current-node nil) + (let ((start-node (elopher-make-node nil nil #'elopher-get-index-node))) + (elopher-visit-node start-node))) + ;;; elopher.el ends here