X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elopher.el;h=8237b63f823da19ac12b479d9fb308e8afc7f182;hb=9366a545023648306990b05f2f63d8fdc0cc0c4d;hp=30383ae57d06cac614df92c55db204873937f533;hpb=2a3908c9deef367de80495ffeae94e46329ee67a;p=elpher.git diff --git a/elopher.el b/elopher.el index 30383ae..8237b63 100644 --- a/elopher.el +++ b/elopher.el @@ -6,6 +6,46 @@ ;;; Code: +;;; Global constants +;; + +(defconst elopher-version "1.0.0" + "Current version of elopher.") + +(defconst elopher-margin-width 6 + "Width of left-hand margin used when rendering indicies.") + +(defconst elopher-start-index + (mapconcat + 'identity + (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\tfake\tfake\t1" + "i - tab/shift-tab: next/prev directory entry on current page\tfake\tfake\t1" + "i - RET/mouse-1: open directory entry under cursor\tfake\tfake\t1" + "i - u: return to parent directory entry\tfake\tfake\t1" + "i - g: go to a particular page\tfake\tfake\t1" + "i - r: reload current page\tfake\tfake\t1" + "i - d: download directory entry under cursor\tfake\tfake\t1" + "i - w: display the raw server response for the current page\tfake\tfake\t1" + "i\tfake\tfake\t1" + "iPlaces to start exploring Gopherspace:\tfake\tfake\t1" + "i\tfake\tfake\t1" + "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70" + "i\tfake\tfake\t1" + "iAlternatively, select the following item and enter some\tfake\tfake\t1" + "isearch terms:\tfake\tfake\t1" + "i\tfake\tfake\t1" + "7Veronica-2 Gopher Search Engine\t/v2/vs\tgopher.floodgap.com\t70" + ".") + "\r\n")) + + ;;; Customization group ;; @@ -13,91 +53,155 @@ "A simple gopher client." :group 'applications) - (defcustom elopher-index-face '(foreground-color . "cyan") - "Face used for index records.") + "Face used for index records." + :type '(face)) + (defcustom elopher-text-face '(foreground-color . "white") - "Face used for text records.") + "Face used for text records." + :type '(face)) + (defcustom elopher-info-face '(foreground-color . "gray") - "Face used for info records.") + "Face used for info records." + :type '(face)) + (defcustom elopher-image-face '(foreground-color . "green") - "Face used for image records.") + "Face used for image records." + :type '(face)) + +(defcustom elopher-search-face '(foreground-color . "orange") + "Face used for image records." + :type '(face)) + +(defcustom elopher-http-face '(foreground-color . "yellow") + "Face used for image records." + :type '(face)) + (defcustom elopher-unknown-face '(foreground-color . "red") - "Face used for unknown record types.") -(defcustom elopher-margin-face '(foreground-color . "orange") - "Face used for record margin legend.") + "Face used for unknown record types." + :type '(face)) -;;; Global constants +(defcustom elopher-open-urls-with-eww nil + "If non-nil, open URL selectors using eww. +Otherwise, use the system browser via the BROWSE-URL function." + :type '(boolean)) + +;;; Model ;; -(defconst elopher-version "1.0.0" - "Current version of elopher.") +;; Address -(defconst elopher-margin-width 6 - "Width of left-hand margin used when rendering indicies.") +(defun elopher-make-address (selector host port) + (list selector host port)) -(defvar 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")) +(defun elopher-address-selector (address) + (car address)) +(defun elopher-address-host (address) + (cadr address)) -;;; Mode and keymap -;; +(defun elopher-address-port (address) + (caddr address)) -(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-history-back) - (define-key map (kbd "g") 'elopher-go) - (when (require 'evil nil t) - (evil-define-key 'normal map - (kbd "C-]") 'elopher-follow-closest-link - (kbd "C-t") 'elopher-history-back - (kbd "u") 'elopher-history-back - (kbd "g") 'elopher-go)) - map) - "Keymap for gopher client.") +;; Node -(define-derived-mode elopher-mode special-mode "elopher" - "Major mode for elopher, an elisp gopher client.") +(defun elopher-make-node (parent address getter &optional content pos) + (list parent address getter content pos)) + +(defun elopher-node-parent (node) + (elt node 0)) + +(defun elopher-node-address (node) + (elt node 1)) + +(defun elopher-node-getter (node) + (elt node 2)) + +(defun elopher-node-content (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)))) + +(defun elopher-restore-pos () + (let ((pos (elopher-node-pos elopher-current-node))) + (if pos + (goto-char pos) + (goto-char (point-min))))) + +;; Node graph traversal + +(defvar elopher-current-node) + +(defun elopher-visit-node (node &optional getter) + (elopher-save-pos) + (setq elopher-current-node node) + (if getter + (funcall 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-set-node-content elopher-current-node nil) + (elopher-visit-node elopher-current-node)) +;;; Buffer preparation +;; + +(defmacro elopher-with-clean-buffer (&rest args) + (list 'progn + '(switch-to-buffer "*elopher*") + '(elopher-mode) + (append (list 'let '((inhibit-read-only t)) + '(erase-buffer)) + args))) ;;; Index rendering ;; +(defun elopher-insert-index (string) + "Insert the index corresponding to STRING into the current buffer." + (dolist (line (split-string string "\r\n")) + (unless (= (length line) 0) + (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 (propertize - (format (concat "%" (number-to-string elopher-margin-width) "s") - (concat "[" type-name "] ")) - 'face elopher-margin-face)) + (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-render-record (line) +(defun elopher-insert-index-record (line) + "Insert the index record corresponding to LINE into the current buffer." (let* ((type (elt line 0)) (fields (split-string (substring line 1) "\t")) (display-string (elt fields 0)) (selector (elt fields 1)) - (hostname (elt fields 2)) + (host (elt fields 2)) (port (elt fields 3)) - (address (list selector hostname port))) + (address (elopher-make-address selector host port)) + (help-string (format "mouse-1, RET: open %s on %s port %s" + selector host port))) (pcase type (?i (elopher-insert-margin) (insert (propertize display-string @@ -105,145 +209,226 @@ (?0 (elopher-insert-margin "T") (insert-text-button display-string 'face elopher-text-face - 'link-getter #'elopher-get-text - 'link-address address + 'elopher-node (elopher-make-node elopher-current-node + 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 - 'link-getter #'elopher-get-index - 'link-address address + 'elopher-node (elopher-make-node elopher-current-node + address + #'elopher-get-index-node) 'action #'elopher-click-link - 'follow-link t)) - (?p (elopher-insert-margin "img") + 'follow-link t + 'help-echo help-string)) + ((or ?g ?p ?I) (elopher-insert-margin "im") (insert-text-button display-string - 'face elopher-image-face - 'link-getter #'elopher-get-image - 'link-address address - 'action #'elopher-click-link - 'follow-link t)) + '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 "S") + (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)) + (?h (elopher-insert-margin "W") + (let ((url (elt (split-string selector "URL:") 1))) + (insert-text-button display-string + 'face elopher-http-face + 'elopher-url url + 'action #'elopher-click-url + 'follow-link t + 'help-echo (format "mouse-1, RET: open url %s" url)))) (?.) ; Occurs at end of index, can safely ignore. (tp (elopher-insert-margin (concat (char-to-string tp) "?")) (insert (propertize display-string 'face elopher-unknown-face)))) (insert "\n"))) -(defvar elopher-incomplete-record "") - -(defun elopher-render-complete-records (string) - (let* ((til-now (string-join (list elopher-incomplete-record string))) - (lines (split-string til-now "\r\n"))) - (dotimes (idx (length lines)) - (if (< idx (- (length lines) 1)) - (let ((line (elt lines idx))) - (unless (string-empty-p line) - (elopher-render-record line))) - (setq elopher-incomplete-record (elt lines idx)))))) - - -;;; History management -;; - -(defvar elopher-history nil - "List of pages in elopher history.") - -(defun elopher-push-history () - "Add current contents of buffer, including point, to history." - (unless (string-empty-p (buffer-string)) - (push - (list (buffer-string) - (point)) - elopher-history))) - -(defun elopher-pop-history () - "Restore most recent page from history." - (interactive) - (if (get-buffer "*elopher*") - (if elopher-history - (let* ((inhibit-read-only t) - (prev-page (pop elopher-history)) - (page-string (car prev-page)) - (page-point (cadr prev-page))) - (switch-to-buffer "*elopher*") - (erase-buffer) - (insert page-string) - (goto-char page-point)) - (message "Already at start of history.")) - (message "No elopher buffer found."))) - ;;; Selector retrieval (all kinds) ;; +(defvar elopher-selector-string) -(defun elopher-get-selector (selector host port filter &optional sentinel) - (switch-to-buffer "*elopher*") - (elopher-mode) - (elopher-push-history) - (let ((inhibit-read-only t)) - (erase-buffer)) +(defun elopher-get-selector (address after) + "Retrieve selector specified by ADDRESS, then execute AFTER. +The result is stored as a string in the variable elopher-selector-string." + (setq elopher-selector-string "") + (let ((p (get-process "elopher-process"))) + (if p (delete-process p))) (make-network-process :name "elopher-process" - :host host - :service (if port port 70) - :filter filter - :sentinel sentinel) - (process-send-string "elopher-process" (concat selector "\n"))) + :host (elopher-address-host address) + :service (elopher-address-port address) + :filter (lambda (proc string) + (setq elopher-selector-string (concat elopher-selector-string string))) + :sentinel after) + (process-send-string "elopher-process" + (concat (elopher-address-selector address) "\n"))) ;; Index retrieval -(defun elopher-index-filter (proc string) - (let ((marker (process-mark proc)) - (inhibit-read-only t)) - (if (not (marker-position marker)) - (set-marker marker 0 (current-buffer))) - (save-excursion - (goto-char marker) - (elopher-render-complete-records string) - (set-marker marker (point))))) - -(defun elopher-get-index (selector host port) - (setq elopher-incomplete-record "") - (elopher-get-selector selector host port - #'elopher-index-filter)) +(defun elopher-get-index-node () + (let ((content (elopher-node-content elopher-current-node)) + (address (elopher-node-address elopher-current-node))) + (if content + (progn + (elopher-with-clean-buffer + (insert content)) + (elopher-restore-pos)) + (if address + (progn + (elopher-with-clean-buffer + (insert "LOADING DIRECTORY...")) + (elopher-get-selector address + (lambda (proc event) + (elopher-with-clean-buffer + (elopher-insert-index elopher-selector-string)) + (elopher-restore-pos) + (elopher-set-node-content elopher-current-node + (buffer-string))))) + (progn + (elopher-with-clean-buffer + (elopher-insert-index elopher-start-index)) + (elopher-restore-pos) + (elopher-set-node-content elopher-current-node + (buffer-string))))))) ;; Text retrieval -(defun elopher-text-filter (proc string) - (let ((marker (process-mark proc)) - (inhibit-read-only t)) - (if (not (marker-position marker)) - (set-marker marker 0 (current-buffer))) - (save-excursion - (goto-char marker) - (dolist (line (split-string string "\r")) - (insert line)) - (set-marker marker (point))))) - -(defun elopher-get-text (selector host port) - (elopher-get-selector selector host port - #'elopher-text-filter)) +(defun elopher-process-text (string) + (let ((chopped-str (replace-regexp-in-string "\r\n\.\r\n$" "\r\n" string))) + (replace-regexp-in-string "\r" "" chopped-str))) + +(defun elopher-get-text-node () + (let ((content (elopher-node-content elopher-current-node)) + (address (elopher-node-address elopher-current-node))) + (if content + (progn + (elopher-with-clean-buffer + (insert content)) + (elopher-restore-pos)) + (progn + (elopher-with-clean-buffer + (insert "LOADING TEXT...")) + (elopher-get-selector address + (lambda (proc event) + (elopher-with-clean-buffer + (insert (elopher-process-text elopher-selector-string))) + (elopher-restore-pos) + (elopher-set-node-content elopher-current-node + (buffer-string)))))))) ;; Image retrieval -(defvar elopher-image-buffer "") - -(defun elopher-image-filter (proc string) - (setq elopher-image-buffer (concat elopher-image-buffer string))) - -(defun elopher-image-sentinel (proc event) - (let ((inhibit-read-only t)) - (insert-image (create-image elopher-image-buffer)))) - -(defun elopher-get-image (selector host port) - (setq elopher-image-buffer "") - (elopher-get-selector selector host port - #'elopher-image-filter - #'elopher-image-sentinel)) - - -;;; Navigation methods +(defun elopher-get-image-node () + (let ((content (elopher-node-content elopher-current-node)) + (address (elopher-node-address elopher-current-node))) + (if content + (progn + (elopher-with-clean-buffer + (insert-image content)) + (setq cursor-type nil) + (elopher-restore-pos)) + (progn + (elopher-with-clean-buffer + (insert "LOADING IMAGE...")) + (elopher-get-selector address + (lambda (proc event) + (let ((image (create-image + (string-as-unibyte elopher-selector-string) + nil t))) + (elopher-with-clean-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 + (elopher-with-clean-buffer + (insert content)) + (elopher-restore-pos) + (message "Displaying cached search results. Reload to perform a new search.")) + (let* ((query-string (read-string "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)))) + (elopher-with-clean-buffer + (insert "LOADING RESULTS...")) + (elopher-get-selector search-address + (lambda (proc event) + (elopher-with-clean-buffer + (elopher-insert-index elopher-selector-string)) + (goto-char (point-min)) + (elopher-set-node-content elopher-current-node + (buffer-string)))))))) + +;; Raw server response retrieval + +(defun elopher-get-node-raw () + (let* ((content (elopher-node-content elopher-current-node)) + (address (elopher-node-address elopher-current-node))) + (elopher-with-clean-buffer + (insert "LOADING RAW SERVER RESPONSE...")) + (if address + (elopher-get-selector address + (lambda (proc event) + (elopher-with-clean-buffer + (insert elopher-selector-string)) + (goto-char (point-min)))) + (progn + (elopher-with-clean-buffer + (insert elopher-start-index)) + (goto-char (point-min))))) + (message "Displaying raw server response. Reload to return to standard view.")) + + +;; File export retrieval + +(defvar elopher-download-filename) + +(defun elopher-get-node-download () + (let* ((address (elopher-node-address elopher-current-node)) + (selector (elopher-address-selector address))) + (unwind-protect + (let* ((filename-proposal (file-name-nondirectory selector)) + (filename (read-file-name "Save file as: " + nil nil nil + (if (> (length filename-proposal) 0) + filename-proposal + "gopher.file")))) + (message "Downloading...") + (setq elopher-download-filename filename) + (elopher-get-selector address + (lambda (proc event) + (let ((coding-system-for-write 'binary)) + (with-temp-file elopher-download-filename + (insert elopher-selector-string))) + (message (format "Download complate, saved to file %s." + elopher-download-filename))))) + (elopher-visit-parent-node)))) + + +;;; Navigation procedures ;; (defun elopher-next-link () @@ -255,7 +440,14 @@ (backward-button 1)) (defun elopher-click-link (button) - (apply (button-get button 'link-getter) (button-get button 'link-address))) + (let ((node (button-get button 'elopher-node))) + (elopher-visit-node node))) + +(defun elopher-click-url (button) + (let ((url (button-get button 'elopher-url))) + (if elopher-open-urls-with-eww + (browse-web url) + (browse-url url)))) (defun elopher-follow-closest-link () (interactive) @@ -264,7 +456,70 @@ (defun elopher-go () "Go to a particular gopher site." (interactive) - (elopher-get-index "" (read-from-minibuffer "Gopher host: ") 70)) + (let* ( + (hostname (read-string "Gopher host: ")) + (selector (read-string "Selector (default none): " nil nil "")) + (port (read-string "Port (default 70): " nil nil 70)) + (address (list selector hostname port))) + (elopher-visit-node + (elopher-make-node elopher-current-node + address + #'elopher-get-index-node)))) + +(defun elopher-reload () + "Reload current page." + (interactive) + (elopher-reload-current-node)) + +(defun elopher-view-raw () + "View current page as plain text." + (interactive) + (elopher-visit-node elopher-current-node + #'elopher-get-node-raw)) + +(defun elopher-back () + "Go to previous site." + (interactive) + (if (elopher-node-parent elopher-current-node) + (elopher-visit-parent-node) + (message "No previous site."))) + +(defun elopher-download () + "Download the link at point." + (interactive) + (let ((button (button-at (point)))) + (if button + (elopher-visit-node (button-get button 'elopher-node) + #'elopher-get-node-download) + (message "No link selected.")))) + + +;;; Mode and keymap +;; + +(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-back) + (define-key map (kbd "g") 'elopher-go) + (define-key map (kbd "r") 'elopher-reload) + (define-key map (kbd "w") 'elopher-view-raw) + (define-key map (kbd "d") 'elopher-download) + (when (fboundp 'evil-define-key) + (evil-define-key 'normal map + (kbd "C-]") 'elopher-follow-closest-link + (kbd "C-t") 'elopher-back + (kbd "u") 'elopher-back + (kbd "g") 'elopher-go + (kbd "r") 'elopher-reload + (kbd "w") 'elopher-view-raw + (kbd "d") 'elopher-download)) + map) + "Keymap for gopher client.") + +(define-derived-mode elopher-mode special-mode "elopher" + "Major mode for elopher, an elisp gopher client.") ;;; Main start procedure @@ -273,13 +528,10 @@ (defun elopher () "Start elopher with default landing page." (interactive) - (switch-to-buffer "*elopher*") - (elopher-mode) - (setq elopher-history nil) - (let ((inhibit-read-only t)) - (erase-buffer) - (save-excursion - (elopher-render-complete-records elopher-start-page)))) - + (setq elopher-current-node nil) + (let ((start-node (elopher-make-node nil nil #'elopher-get-index-node))) + (elopher-visit-node start-node)) + "Started Elopher.") ; Otherwise (elopher) evaluates to start page string. ;;; elopher.el ends here +