X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elopher.el;h=b8170c5521da6792e4192bb6faa0d6feae25ee7b;hb=ce7691f3d1a8f26f309fd9693b979ddec8cef4af;hp=b40007f69cf7a6b888c69ca91d74d0c7b5bc7326;hpb=1e2de704ced6c5ea7fa93ddea8eebf9c9f11186c;p=elpher.git diff --git a/elopher.el b/elopher.el index b40007f..b8170c5 100644 --- a/elopher.el +++ b/elopher.el @@ -16,7 +16,8 @@ "Width of left-hand margin used when rendering indicies.") (defconst elopher-start-index - (string-join + (mapconcat + 'identity (list "i\tfake\tfake\t1" "i--------------------------------------------\tfake\tfake\t1" "i Elopher Gopher Client \tfake\tfake\t1" @@ -24,19 +25,23 @@ "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\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 site\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" - "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" + "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")) @@ -49,15 +54,37 @@ :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.") + "Face used for unknown record types." + :type '(face)) + +(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 ;; @@ -116,11 +143,12 @@ (defvar elopher-current-node) -(defun elopher-visit-node (node) +(defun elopher-visit-node (node &optional raw) (elopher-save-pos) - (elopher-prepare-buffer) (setq elopher-current-node node) - (funcall (elopher-node-getter node))) + (if raw + (elopher-get-node-raw) + (funcall (elopher-node-getter node)))) (defun elopher-visit-parent-node () (let ((parent-node (elopher-node-parent elopher-current-node))) @@ -131,24 +159,24 @@ (elopher-set-node-content elopher-current-node nil) (elopher-visit-node elopher-current-node)) - ;;; Buffer preparation ;; -(defun elopher-prepare-buffer () - (switch-to-buffer "*elopher*") - (elopher-mode) - (let ((inhibit-read-only t)) - (erase-buffer))) - +(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) - "Inserts the index corresponding to STRING into the current buffer." + "Insert the index corresponding to STRING into the current buffer." (dolist (line (split-string string "\r\n")) - (unless (string-empty-p line) + (unless (= (length line) 0) (elopher-insert-index-record line)))) (defun elopher-insert-margin (&optional type-name) @@ -164,15 +192,16 @@ (insert (make-string elopher-margin-width ?\s)))) (defun elopher-insert-index-record (line) - "Inserts the index record corresponding to LINE into the current buffer." + "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)) - (address (elopher-make-address (elt fields 1) (elt fields 2) (elt fields 3))) + (selector (elt fields 1)) + (host (elt fields 2)) + (port (elt fields 3)) + (address (elopher-make-address selector host port)) (help-string (format "mouse-1, RET: open %s on %s port %s" - (elopher-address-selector address) - (elopher-address-host address) - (elopher-address-port address)))) + selector host port))) (pcase type (?i (elopher-insert-margin) (insert (propertize display-string @@ -195,7 +224,7 @@ 'action #'elopher-click-link 'follow-link t 'help-echo help-string)) - (?p (elopher-insert-margin "im") + ((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 @@ -204,6 +233,23 @@ '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 @@ -216,13 +262,9 @@ (defvar elopher-selector-string) -(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. - -If BINARY is non-nil, the selector is expected to return a -binary result, otherwise otherwise utf-8 is assumed." +(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))) @@ -230,9 +272,6 @@ binary result, otherwise otherwise utf-8 is assumed." :name "elopher-process" :host (elopher-address-host address) :service (elopher-address-port address) - :coding (if binary - '(utf-8 . binary) - '(utf-8 . utf-8)) :filter (lambda (proc string) (setq elopher-selector-string (concat elopher-selector-string string))) :sentinel after) @@ -246,19 +285,22 @@ binary result, otherwise otherwise utf-8 is assumed." (address (elopher-node-address elopher-current-node))) (if content (progn - (let ((inhibit-read-only t)) + (elopher-with-clean-buffer (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-restore-pos) - (elopher-set-node-content elopher-current-node - (buffer-string)))) + (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 - (let ((inhibit-read-only t)) + (elopher-with-clean-buffer (elopher-insert-index elopher-start-index)) (elopher-restore-pos) (elopher-set-node-content elopher-current-node @@ -266,24 +308,28 @@ binary result, otherwise otherwise utf-8 is assumed." ;; Text retrieval -(defun elopher-strip-CRs (string) - (replace-regexp-in-string "\r" "" string)) +(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 - (let ((inhibit-read-only t)) + (elopher-with-clean-buffer (insert content)) (elopher-restore-pos)) - (elopher-get-selector address - (lambda (proc event) - (let ((inhibit-read-only t)) - (insert (elopher-strip-CRs elopher-selector-string))) - (elopher-restore-pos) - (elopher-set-node-content elopher-current-node - (buffer-string))))))) + (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 @@ -292,19 +338,85 @@ binary result, otherwise otherwise utf-8 is assumed." (address (elopher-node-address elopher-current-node))) (if content (progn - (let ((inhibit-read-only t)) + (elopher-with-clean-buffer (insert-image content)) + (setq cursor-type nil) (elopher-restore-pos)) - (elopher-get-selector address - (lambda (proc event) - (let ((image (create-image elopher-selector-string)) - (inhibit-read-only t)) - (insert-image image) - (elopher-restore-pos) - (elopher-set-node-content image))) - 'binary)))) - - + (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-download-node (node filename) + (let* ((address (elopher-node-address node))) + (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)))))) ;;; Navigation procedures ;; @@ -321,6 +433,12 @@ binary result, otherwise otherwise utf-8 is assumed." (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) (push-button)) @@ -328,9 +446,10 @@ binary result, otherwise otherwise utf-8 is assumed." (defun elopher-go () "Go to a particular gopher site." (interactive) - (let* ((selector "") - (hostname (read-from-minibuffer "Gopher host: ")) - (port 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 @@ -338,10 +457,15 @@ binary result, otherwise otherwise utf-8 is assumed." #'elopher-get-index-node)))) (defun elopher-reload () - "Reload current site." + "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 t)) + (defun elopher-back () "Go to previous site." (interactive) @@ -349,6 +473,22 @@ binary result, otherwise otherwise utf-8 is assumed." (elopher-visit-parent-node) (message "No previous site."))) +(defun elopher-download () + "Download the link at point." + (interactive) + (let ((button (button-at (point)))) + (if button + (let* ((node (button-get button 'elopher-node)) + (address (elopher-node-address node)) + (selector (elopher-address-selector address)) + (filename-proposal (file-name-nondirectory selector)) + (filename (read-file-name "Name of file to write: " + nil nil nil + (if (> (length filename-proposal) 0) + filename-proposal + "gopher.file")))) + (elopher-download-node node filename)) + (message "No link selected.")))) ;;; Mode and keymap ;; @@ -360,13 +500,17 @@ binary result, otherwise otherwise utf-8 is assumed." (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) + (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 "r") 'elopher-reload + (kbd "w") 'elopher-view-raw + (kbd "d") 'elopher-download)) map) "Keymap for gopher client.") @@ -384,3 +528,4 @@ binary result, otherwise otherwise utf-8 is assumed." (elopher-visit-node start-node))) ;;; elopher.el ends here +