X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=37353451416e8510cdff61adc6a1da83b4908eb9;hb=5ca522d4fab62b678251dc54bdedad99212793cd;hp=c716d0c5f51ba2ce1dbe70798f1b8575d7615a51;hpb=84089fd5c210ae6858ea45cfcbc2aae022d70750;p=elpher.git diff --git a/elpher.el b/elpher.el index c716d0c..3735345 100644 --- a/elpher.el +++ b/elpher.el @@ -1,4 +1,4 @@ -;;; elpher.el --- A friendly gopher client. +;;; elpher.el --- A friendly gopher client. -*- lexical-binding:t -*- ;; Copyright (C) 2019 Tim Vaughan @@ -70,24 +70,24 @@ "Width of left-hand margin used when rendering indicies.") (defconst elpher-type-map - '(((gopher ?0) elpher-get-text-node "txt" elpher-text) - ((gopher ?1) elpher-get-index-node "/" elpher-index) - ((gopher ?4) elpher-get-node-download "bin" elpher-binary) - ((gopher ?5) elpher-get-node-download "bin" elpher-binary) - ((gopher ?7) elpher-get-search-node "?" elpher-search) - ((gopher ?8) elpher-get-telnet-node "tel" elpher-telnet) - ((gopher ?9) elpher-get-node-download "bin" elpher-binary) - ((gopher ?g) elpher-get-image-node "img" elpher-image) - ((gopher ?p) elpher-get-image-node "img" elpher-image) - ((gopher ?I) elpher-get-image-node "img" elpher-image) - ((gopher ?d) elpher-get-node-download "doc" elpher-binary) - ((gopher ?P) elpher-get-node-download "doc" elpher-binary) - ((gopher ?s) elpher-get-node-download "snd" elpher-binary) - ((gopher ?h) elpher-get-html-node "htm" elpher-html) - (gemini elpher-get-gemini-node "gem" elpher-gemini) - (other-url elpher-get-other-url-node "url" elpher-other-url) - ((special bookmarks) elpher-get-bookmarks-node) - ((special start) elpher-get-start-node)) + '(((gopher ?0) elpher-get-gopher-node elpher-render-text "txt" elpher-text) + ((gopher ?1) elpher-get-gopher-node elpher-render-index "/" elpher-index) + ((gopher ?4) elpher-get-gopher-node elpher-render-download "bin" elpher-binary) + ((gopher ?5) elpher-get-gopher-node elpher-render-download "bin" elpher-binary) + ((gopher ?7) elpher-get-gopher-query-node elpher-render-index "?" elpher-search) + ((gopher ?9) elpher-get-gopher-node elpher-render-node-download "bin" elpher-binary) + ((gopher ?g) elpher-get-gopher-node elpher-render-image "img" elpher-image) + ((gopher ?p) elpher-get-gopher-node elpher-render-image "img" elpher-image) + ((gopher ?I) elpher-get-gopher-node elpher-render-image "img" elpher-image) + ((gopher ?d) elpher-get-gopher-node elpher-render-download "doc" elpher-binary) + ((gopher ?P) elpher-get-gopher-node elpher-render-download "doc" elpher-binary) + ((gopher ?s) elpher-get-gopher-node elpher-render-download "snd" elpher-binary) + ((gopher ?h) elpher-get-gopher-node elpher-render-html "htm" elpher-html) + (gemini elpher-get-gemini-node elpher-render-gemini "gem" elpher-gemini) + (telnet elpher-get-telnet-node nil "tel" elpher-telnet) + (other-url elpher-get-other-url-node nil "url" elpher-other-url) + ((special bookmarks) elpher-get-bookmarks-node nil) + ((special start) elpher-get-start-node nil)) "Association list from types to getters, margin codes and index faces.") @@ -335,8 +335,8 @@ initially." (defvar elpher-current-node nil) -(defun elpher-visit-node (node &optional getter preserve-parent) - "Visit NODE using its own getter or GETTER, if non-nil. +(defun elpher-visit-node (node &optional renderer preserve-parent) + "Visit NODE using its own renderer or RENDERER, if non-nil. Additionally, set the parent of NODE to `elpher-current-node', unless PRESERVE-PARENT is non-nil." (elpher-save-pos) @@ -348,21 +348,22 @@ unless PRESERVE-PARENT is non-nil." (elpher-set-node-parent node (elpher-node-parent elpher-current-node)) (elpher-set-node-parent node elpher-current-node))) (setq elpher-current-node node) - (if getter - (funcall getter) - (let* ((address (elpher-node-address node)) - (type (elpher-address-type address)) - (type-record (cdr (assoc type elpher-type-map)))) - (if type-record - (funcall (car type-record)) - (elpher-visit-parent-node) - (pcase type - (`(gopher ,type-char) - (error "Unsupported gopher selector type '%c' for '%s'" - type-char (elpher-address-to-url address))) - (else - (error "Unsupported address type '%S' for '%s'" - type (elpher-address-to-url address)))))))) + (let* ((address (elpher-node-address node)) + (type (elpher-address-type address)) + (type-record (cdr (assoc type elpher-type-map)))) + (if type-record + (funcall (car type-record) + (if renderer + renderer + (cadr type-record))) + (elpher-visit-parent-node) + (pcase type + (`(gopher ,type-char) + (error "Unsupported gopher selector type '%c' for '%s'" + type-char (elpher-address-to-url address))) + (else + (error "Unsupported address type '%S' for '%s'" + type (elpher-address-to-url address))))))) (defun elpher-visit-parent-node () "Visit the parent of the current node." @@ -427,82 +428,6 @@ away CRs and any terminating period." (replace-regexp-in-string "\r" "" string)))) -;;; Index rendering -;; - -(defun elpher-insert-index (string) - "Insert the index corresponding to STRING into the current buffer." - ;; Should be able to split directly on CRLF, but some non-conformant - ;; LF-only servers sadly exist, hence the following. - (let ((str-processed (elpher-preprocess-text-response string))) - (dolist (line (split-string str-processed "\n")) - (unless (= (length line) 0) - (let* ((type (elt line 0)) - (fields (split-string (substring line 1) "\t")) - (display-string (elt fields 0)) - (selector (elt fields 1)) - (host (elt fields 2)) - (port (if (elt fields 3) - (string-to-number (elt fields 3)) - nil)) - (address (elpher-make-gopher-address type selector host port))) - (elpher-insert-index-record display-string address)))))) - -(defun elpher-insert-margin (&optional type-name) - "Insert index margin, optionally containing the TYPE-NAME, into the current buffer." - (if type-name - (progn - (insert (format (concat "%" (number-to-string (- elpher-margin-width 1)) "s") - (concat - (propertize "[" 'face 'elpher-margin-brackets) - (propertize type-name 'face 'elpher-margin-key) - (propertize "]" 'face 'elpher-margin-brackets)))) - (insert " ")) - (insert (make-string elpher-margin-width ?\s)))) - -(defun elpher-node-button-help (node) - "Return a string containing the help text for a button corresponding to NODE." - (let ((address (elpher-node-address node))) - (format "mouse-1, RET: open '%s'" (elpher-address-to-url address)))) - -(defun elpher-insert-index-record (display-string &optional address) - "Function to insert an index record into the current buffer. -The contents of the record are dictated by DISPLAY-STRING and ADDRESS. -If ADDRESS is not supplied or nil the record is rendered as an -'information' line." - (let* ((type (if address (elpher-address-type address) nil)) - (type-map-entry (cdr (assoc type elpher-type-map)))) - (if type-map-entry - (let* ((margin-code (elt type-map-entry 1)) - (face (elt type-map-entry 2)) - (node (elpher-make-node display-string address))) - (elpher-insert-margin margin-code) - (insert-text-button display-string - 'face face - 'elpher-node node - 'action #'elpher-click-link - 'follow-link t - 'help-echo (elpher-node-button-help node))) - (pcase type - ((or '(gopher ?i) 'nil) ;; Information - (elpher-insert-margin) - (insert (propertize - (if elpher-buttonify-urls-in-directories - (elpher-buttonify-urls display-string) - display-string) - 'face 'elpher-info))) - (`(gopher ,selector-type) ;; Unknown - (elpher-insert-margin (concat (char-to-string selector-type) "?")) - (insert (propertize display-string - 'face 'elpher-unknown))))) - (insert "\n"))) - -(defun elpher-click-link (button) - "Function called when the gopher link BUTTON is activated (via mouse or keypress)." - (let ((node (button-get button 'elpher-node))) - (elpher-visit-node node))) - - ;;; Network error reporting ;; @@ -510,12 +435,12 @@ If ADDRESS is not supplied or nil the record is rendered as an (elpher-with-clean-buffer (insert (propertize "\n---- ERROR -----\n\n" 'face 'error) "When attempting to retrieve " (elpher-address-to-url address) ":\n" - (error-message-string the-error) ".\n" + (error-message-string error) ".\n" (propertize "\n----------------\n\n" 'face 'error) "Press 'u' to return to the previous page."))) -;;; Gopher selector retrieval (all kinds) +;;; Gopher selector retrieval ;; (defun elpher-process-cleanup () @@ -579,30 +504,105 @@ up to the calling function." (propertize "\n----------------\n\n" 'face 'error) "Press 'u' to return to the previous page."))))))) -;; Index retrieval - -(defun elpher-get-index-node () - "Getter which retrieves the current node contents as an index." +(defun elpher-get-gopher-node (renderer) (let* ((address (elpher-node-address elpher-current-node)) (content (elpher-get-cached-content address))) - (if content - (progn - (elpher-with-clean-buffer - (insert content) - (elpher-restore-pos))) + (if (and content (funcall renderer nil)) + (elpher-with-clean-buffer + (insert content) + (elpher-restore-pos)) (elpher-with-clean-buffer - (insert "LOADING DIRECTORY... (use 'u' to cancel)")) + (insert "LOADING... (use 'u' to cancel)")) (elpher-get-selector address (lambda (proc event) (unless (string-prefix-p "deleted" event) - (elpher-with-clean-buffer - (elpher-insert-index elpher-selector-string) - (elpher-restore-pos) - (elpher-cache-content - (elpher-node-address elpher-current-node) - (buffer-string))))))))) + (funcall renderer elpher-selector-string) + (elpher-restore-pos))))))) + +;; Index rendering + +(defun elpher-insert-index (string) + "Insert the index corresponding to STRING into the current buffer." + ;; Should be able to split directly on CRLF, but some non-conformant + ;; LF-only servers sadly exist, hence the following. + (let ((str-processed (elpher-preprocess-text-response string))) + (dolist (line (split-string str-processed "\n")) + (unless (= (length line) 0) + (let* ((type (elt line 0)) + (fields (split-string (substring line 1) "\t")) + (display-string (elt fields 0)) + (selector (elt fields 1)) + (host (elt fields 2)) + (port (if (elt fields 3) + (string-to-number (elt fields 3)) + nil)) + (address (elpher-make-gopher-address type selector host port))) + (elpher-insert-index-record display-string address)))))) + +(defun elpher-insert-margin (&optional type-name) + "Insert index margin, optionally containing the TYPE-NAME, into the current buffer." + (if type-name + (progn + (insert (format (concat "%" (number-to-string (- elpher-margin-width 1)) "s") + (concat + (propertize "[" 'face 'elpher-margin-brackets) + (propertize type-name 'face 'elpher-margin-key) + (propertize "]" 'face 'elpher-margin-brackets)))) + (insert " ")) + (insert (make-string elpher-margin-width ?\s)))) + +(defun elpher-node-button-help (node) + "Return a string containing the help text for a button corresponding to NODE." + (let ((address (elpher-node-address node))) + (format "mouse-1, RET: open '%s'" (elpher-address-to-url address)))) + +(defun elpher-insert-index-record (display-string &optional address) + "Function to insert an index record into the current buffer. +The contents of the record are dictated by DISPLAY-STRING and ADDRESS. +If ADDRESS is not supplied or nil the record is rendered as an +'information' line." + (let* ((type (if address (elpher-address-type address) nil)) + (type-map-entry (cdr (assoc type elpher-type-map)))) + (if type-map-entry + (let* ((margin-code (elt type-map-entry 2)) + (face (elt type-map-entry 3)) + (node (elpher-make-node display-string address))) + (elpher-insert-margin margin-code) + (insert-text-button display-string + 'face face + 'elpher-node node + 'action #'elpher-click-link + 'follow-link t + 'help-echo (elpher-node-button-help node))) + (pcase type + ((or '(gopher ?i) 'nil) ;; Information + (elpher-insert-margin) + (insert (propertize + (if elpher-buttonify-urls-in-directories + (elpher-buttonify-urls display-string) + display-string) + 'face 'elpher-info))) + (`(gopher ,selector-type) ;; Unknown + (elpher-insert-margin (concat (char-to-string selector-type) "?")) + (insert (propertize display-string + 'face 'elpher-unknown))))) + (insert "\n"))) + +(defun elpher-click-link (button) + "Function called when the gopher link BUTTON is activated (via mouse or keypress)." + (let ((node (button-get button 'elpher-node))) + (elpher-visit-node node))) -;; Text retrieval +(defun elpher-render-index (data &optional mime-type-string) + "Render DATA as an index, MIME-TYPE-STRING is unused" + (elpher-with-clean-buffer + (if (not data) + t + (elpher-insert-index data) + (elpher-cache-content (elpher-node-address elpher-current-node) + (buffer-string))))) + +;; Text rendering (defconst elpher-url-regex "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\|\[[a-zA-Z0-9:]+\]\\)\\(?3::[0-9]+\\)?\\(?4:/[^<> \r\n\t(),]*\\)?" @@ -624,185 +624,114 @@ up to the calling function." 'help-echo (elpher-node-button-help node)))) (buffer-string))) -(defun elpher-get-text-node () - "Getter which retrieves the current node contents as a text document." - (let* ((address (elpher-node-address elpher-current-node)) - (content (elpher-get-cached-content address))) - (if content - (progn - (elpher-with-clean-buffer - (insert content) - (elpher-restore-pos))) - (progn - (elpher-with-clean-buffer - (insert "LOADING TEXT... (use 'u' to cancel)")) - (elpher-get-selector address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (elpher-with-clean-buffer - (insert (elpher-buttonify-urls - (elpher-preprocess-text-response - elpher-selector-string))) - (elpher-restore-pos) - (elpher-cache-content - (elpher-node-address elpher-current-node) - (buffer-string)))))))))) +(defun elpher-render-text (data &optional mime-type-string) + "Render DATA as text, MIME-TYPE-STRING is unused." + (elpher-with-clean-buffer + (if (not data) + t + (insert (elpher-buttonify-urls (elpher-preprocess-text-response data))) + (elpher-cache-content + (elpher-node-address elpher-current-node) + (buffer-string))))) ;; Image retrieval -(defun elpher-get-image-node () - "Getter which retrieves the current node contents as an image to view." - (let* ((address (elpher-node-address elpher-current-node))) +(defun elpher-render-image (data &optional mime-type-string) + "Display DATA as image, MIME-TYPE-STRING is unused." + (if (not data) + nil (if (display-images-p) (progn - (elpher-with-clean-buffer - (insert "LOADING IMAGE... (use 'u' to cancel)")) - (elpher-get-selector address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (let ((image (create-image - elpher-selector-string - nil t))) - (elpher-with-clean-buffer - (insert-image image) - (elpher-restore-pos))))))) - (elpher-get-node-download)))) - -;; Search retrieval - -(defun elpher-get-search-node () - "Getter which submits a search query to the address of the current node." - (let* ((address (elpher-node-address elpher-current-node)) - (content (elpher-get-cached-content address)) - (aborted t)) - (if content - (progn - (elpher-with-clean-buffer - (insert content) - (elpher-restore-pos)) - (message "Displaying cached search results. Reload to perform a new search.")) + (let ((image (create-image + data + nil t))) + (elpher-with-clean-buffer + (insert-image image) + (elpher-restore-pos)))) + (elpher-save-to-file data)))) + +;; Search retrieval and rendering + +(defun elpher-get-gopher-query-node (renderer) + (let* ((address (elpher-node-address elpher-current-node)) + (content (elpher-get-cached-content address)) + (aborted t)) + (if (and content (funcall renderer nil)) + (elpher-with-clean-buffer + (insert content) + (elpher-restore-pos) + (message "Displaying cached search results. Reload to perform a new search.")) (unwind-protect (let* ((query-string (read-string "Query: ")) (query-selector (concat (elpher-gopher-address-selector address) "\t" query-string)) (search-address (elpher-make-gopher-address ?1 - query-selector - (elpher-address-host address) - (elpher-address-port address)))) + query-selector + (elpher-address-host address) + (elpher-address-port address) + (equal (elpher-address-type address) "gophers")))) (setq aborted nil) + (elpher-with-clean-buffer (insert "LOADING RESULTS... (use 'u' to cancel)")) (elpher-get-selector search-address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (elpher-with-clean-buffer - (elpher-insert-index elpher-selector-string)) - (goto-char (point-min)) - (elpher-cache-content - (elpher-node-address elpher-current-node) - (buffer-string)))))) + (lambda (proc event) + (unless (string-prefix-p "deleted" event) + (funcall renderer elpher-selector-string) + (elpher-restore-pos))))) (if aborted (elpher-visit-parent-node)))))) + +;; Raw server response rendering -;; Raw server response retrieval - -(defun elpher-get-node-raw () - "Getter which retrieves the raw server response for the current node." - (let ((address (elpher-node-address elpher-current-node))) +(defun elpher-render-raw (data &optional mime-type-string) + "Display raw DATA in buffer, MIME-TYPE-STRING is unused." + (if (not data) + nil (elpher-with-clean-buffer - (insert "LOADING RAW SERVER RESPONSE... (use 'u' to cancel)")) - (elpher-get-selector address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (elpher-with-clean-buffer - (insert elpher-selector-string) - (goto-char (point-min))))))) - (message "Displaying raw server response. Reload or redraw to return to standard view.")) - -;; File export retrieval + (insert data) + (goto-char (point-min))) + (message "Displaying raw server response. Reload or redraw to return to standard view."))) -(defvar elpher-download-filename) +;; File save "rendering" -(defun elpher-get-node-download () - "Getter which retrieves the current node and writes the result to a file." - (let* ((address (elpher-node-address elpher-current-node)) - (selector (elpher-gopher-address-selector address))) - (elpher-visit-parent-node) ; Do first in case of non-local exits. - (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 elpher-download-filename filename) - (condition-case the-error - (elpher-get-selector address - (lambda (proc event) - (let ((coding-system-for-write 'binary)) - (with-temp-file elpher-download-filename - (insert elpher-selector-string) - (message (format "Download complate, saved to file %s." - elpher-download-filename))))) - t) - (error - (error "Error downloading %s" elpher-download-filename)))))) - -;; HTML node retrieval - -(defun elpher-insert-rendered-html (string) - "Use shr to insert rendered view of html STRING into current buffer." - (let ((dom (with-temp-buffer - (insert string) - (libxml-parse-html-region (point-min) (point-max))))) - (shr-insert-document dom))) - -(defun elpher-get-html-node () - "Getter which retrieves and renders an HTML node." - (let* ((address (elpher-node-address elpher-current-node)) - (selector (elpher-gopher-address-selector address))) - (let ((content (elpher-get-cached-content address))) - (if content - (progn - (elpher-with-clean-buffer - (insert content) - (elpher-restore-pos))) - (elpher-with-clean-buffer - (insert "LOADING HTML... (use 'u' to cancel)")) - (elpher-get-selector address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (elpher-with-clean-buffer - (elpher-insert-rendered-html elpher-selector-string) - (goto-char (point-min)) - (elpher-cache-content - (elpher-node-address elpher-current-node) - (buffer-string)))))))))) +(defun elpher-render-download (data &optional mime-type-string) + "Save DATA to file, MIME-TYPE-STRING is unused." + (if (not data) + nil + (let* ((address (elpher-node-address elpher-current-node)) + (selector (elpher-gopher-address-selector address))) + (elpher-visit-parent-node) ; Do first in case of non-local exits. + (let* ((filename-proposal (file-name-nondirectory selector)) + (filename (read-file-name "Download complete. Save file as: " + nil nil nil + (if (> (length filename-proposal) 0) + filename-proposal + "download.file")))) + (let ((coding-system-for-write 'binary)) + (with-temp-file filename + (insert data))) + (message (format "Saved to file %s." filename)))))) + +;; HTML rendering + +(defun elpher-render-html (data &optional mime-type-string) + "Render DATA as HTML using shr, MIME-TYPE-STRING is unused." + (elpher-with-clean-buffer + (if (not data) + t + (let ((dom (with-temp-buffer + (insert string) + (libxml-parse-html-region (point-min) (point-max))))) + (shr-insert-document dom))))) ;; Gemini node retrieval (defvar elpher-gemini-response) -(defvar elpher-gemini-response-header) -(defvar elpher-gemini-in-header) - -(defun elpher-gemini-response-code () - (elt (split-string elpher-gemini-response-header) 0)) -(defun elpher-gemini-response-meta () - (string-trim (substring elpher-gemini-response-header - (string-match "[ \t]+" elpher-gemini-response-header)))) - -(defun elpher-get-gemini (address after) +(defun elpher-get-gemini-response (address after) "Retrieve gemini ADDRESS, then execute AFTER. -The response header is stored in the variable ‘elpher-gemini-response-header’. -If available, the response is stored in the variable ‘elpher-gemini-response’. - -Usually errors result in an error page being displayed. This is only -appropriate if the selector is to be directly viewed. If PROPAGATE-ERROR -is non-nil, this message is not displayed. Instead, the error propagates -up to the calling function." +The response is stored in the variable ‘elpher-gemini-response’." (setq elpher-gemini-response "") - (setq elpher-gemini-response-header "") - (setq elpher-gemini-in-header t) (if (not (gnutls-available-p)) (error "Cannot retrieve TLS selector: GnuTLS not available") (let* ((kill-buffer-query-functions nil) @@ -816,58 +745,116 @@ up to the calling function." (set-process-coding-system proc 'binary) (set-process-filter proc (lambda (proc string) - (if elpher-gemini-in-header - (progn - (setq elpher-gemini-response-header - (concat elpher-gemini-response-header - (elt (split-string string "\r\n") 0))) - (let ((idx (string-match "\r\n" string))) - (setq elpher-gemini-response - (substring string (+ idx 2))) - (setq elpher-gemini-in-header nil))) - (setq elpher-gemini-response - (concat elpher-gemini-response string))))) + (setq elpher-gemini-response + (concat elpher-gemini-response string)))) (set-process-sentinel proc after) (process-send-string proc (concat (elpher-address-to-url address) "\r\n"))))) -(defun elpher-process-mime-type-string (mime-type-string) - (let ((mime-type-split (split-string mime-type-string ";")) - (mime-type (string-trim (car mime-type-split))) - (parameter-strings (cdr mime-type-split))) - ())) - - -(defun elpher-render-gemini-response (mime-type-string) - (let* ((mime-type-string* (if (string-empty-p mime-type-string) - "text/gemini; charset=utf-8" - mime-type-string)) - (mime-type-split (split-string mime-type-string* ";")) - (mime-type (string-trim (car mime-type-split))) - (parameters (mapcar (lambda (s) - (let ((key-val (split-string s "="))) - (list (downcase (string-trim (car key-val))) - (downcase (string-trim (cadr key-val)))))) - (cdr mime-type-split)))) - (if (and (equal "text/gemini" mime-type) - (not (assoc "charset" parameters))) - (setq parameters (cons (list "charset" "utf-8") parameters))) - (when (string-prefix-p "text/" mime-type) - (if (assoc "charset" parameters) - (setq elpher-gemini-response - (decode-coding-string elpher-gemini-response - (intern (cadr (assoc "charset" parameters)))))) - (setq elpher-gemini-response - (replace-regexp-in-string "\r" "" elpher-gemini-response))) - (pcase mime-type - ((or "text/gemini" "") - (elpher-render--mimetype-text/gemini elpher-gemini-response parameters)) - ((pred (string-prefix-p "text/")) - (elpher-render--mimetype-text/plain elpher-gemini-response parameters)) - ((pred (string-prefix-p "image/")) - (elpher-render--mimetype-image/* elpher-gemini-response parameters)) - (other - (error "Unsupported MIME type %S" mime-type))))) + +(defun elpher-process-gemini-response (renderer) + "Process the gemini response found in the variable `elpher-gemini-response' and +pass the result to RENDERER." + (condition-case the-error + (let* ((response-header (car (split-string elpher-gemini-response "\r\n"))) + (response-body (substring elpher-gemini-response + (+ (string-match "\r\n" elpher-gemini-response) 2))) + (response-code (car (split-string response-header))) + (response-meta (string-trim + (substring response-header + (string-match "[ \t]+" response-header))))) + (pcase (elt response-code 0) + (?1 ; Input required + (elpher-with-clean-buffer + (insert "Gemini server is requesting input.")) + (let* ((query-string (read-string (concat response-meta ": "))) + (url (elpher-address-to-url (elpher-node-address elpher-current-node))) + (query-address (elpher-address-from-url (concat url "?" query-string)))) + (elpher-get-gemini-response query-address + (lambda (proc event) + (unless (string-prefix-p "deleted" event) + (funcall #'elpher-process-gemini-response + renderer) + (elpher-restore-pos)))))) + (?2 ; Normal response + (message response-header) + (funcall renderer response-body response-meta)) + (?3 ; Redirect + (message "Following redirect to %s" response-meta) + (let ((redirect-address (elpher-address-from-gemini-url response-meta))) + (elpher-get-gemini-response redirect-address + (lambda (proc event) + (unless (string-prefix-p "deleted" event) + (funcall #'elpher-process-gemini-response + renderer) + (elpher-restore-pos)))))) + (?4 ; Temporary failure + (error "Gemini server reports TEMPORARY FAILURE for this request")) + (?5 ; Permanent failure + (error "Gemini server reports PERMANENT FAILURE for this request")) + (?6 ; Client certificate required + (error "Gemini server requires client certificate (unsupported at this time)")) + (other + (error "Gemini server responded with unknown response code %S" + response-code)))) + (error + (elpher-network-error (elpher-node-address elpher-current-node) the-error)))) + +(defun elpher-get-gemini-node (renderer) + "Getter which retrieves and renders a Gemini node and renders it using RENDERER." + (let* ((address (elpher-node-address elpher-current-node)) + (content (elpher-get-cached-content address))) + (condition-case the-error + (if (and content (funcall renderer nil)) + (elpher-with-clean-buffer + (insert content) + (elpher-restore-pos)) + (elpher-with-clean-buffer + (insert "LOADING GEMINI... (use 'u' to cancel)")) + (elpher-get-gemini-response address + (lambda (proc event) + (unless (string-prefix-p "deleted" event) + (funcall #'elpher-process-gemini-response + renderer) + (elpher-restore-pos))))) + (error + (elpher-network-error address the-error))))) + + +(defun elpher-render-gemini (body &optional mime-type-string) + "Render gemini response BODY with rendering hints in META." + (if (not body) + t + (let* ((mime-type-string* (if (or (not mime-type-string) + (string-empty-p mime-type-string)) + "text/gemini; charset=utf-8" + mime-type-string)) + (mime-type-split (split-string mime-type-string* ";")) + (mime-type (string-trim (car mime-type-split))) + (parameters (mapcar (lambda (s) + (let ((key-val (split-string s "="))) + (list (downcase (string-trim (car key-val))) + (downcase (string-trim (cadr key-val)))))) + (cdr mime-type-split)))) + (if (and (equal "text/gemini" mime-type) + (not (assoc "charset" parameters))) + (setq parameters (cons (list "charset" "utf-8") parameters))) + (when (string-prefix-p "text/" mime-type) + (if (assoc "charset" parameters) + (setq elpher-gemini-response + (decode-coding-string elpher-gemini-response + (intern (cadr (assoc "charset" parameters)))))) + (setq elpher-gemini-response + (replace-regexp-in-string "\r" "" elpher-gemini-response))) + (pcase mime-type + ((or "text/gemini" "") + (elpher-render-gemini-text/gemini body parameters)) + ((pred (string-prefix-p "text/")) + (elpher-render-gemini-text/plain body parameters)) + ((pred (string-prefix-p "image/")) + (elpher-render-image body)) + (other + (error "Unsupported MIME type %S" mime-type)))))) (defun elpher-gemini-get-link-url (line) (string-trim (elt (split-string (substring line 2)) 0))) @@ -895,7 +882,7 @@ up to the calling function." (setf (url-type address) "gemini"))) address)) -(defun elpher-render--mimetype-text/gemini (data parameters) +(defun elpher-render-gemini-text/gemini (data parameters) (elpher-with-clean-buffer (dolist (line (split-string data "\n")) (if (string-prefix-p "=>" line) @@ -906,81 +893,24 @@ up to the calling function." (elpher-insert-index-record display-string address) (elpher-insert-index-record url address))) (elpher-insert-index-record line))) - (elpher-restore-pos) (elpher-cache-content (elpher-node-address elpher-current-node) (buffer-string)))) -(defun elpher-render--mimetype-text/plain (data parameters) +(defun elpher-render-gemini-text/plain (data parameters) (elpher-with-clean-buffer (insert (elpher-buttonify-urls (elpher-preprocess-text-response data))) - (elpher-restore-pos) (elpher-cache-content (elpher-node-address elpher-current-node) (buffer-string)))) -(defun elpher-render--mimetype-image/* (data parameters) - (let ((image (create-image data nil t))) - (elpher-with-clean-buffer - (insert-image image) - (elpher-restore-pos)))) - -(defun elpher-process-gemini-response (proc event) - (condition-case the-error - (unless (string-prefix-p "deleted" event) - (let ((response-code (elpher-gemini-response-code)) - (meta (elpher-gemini-response-meta))) - (pcase (elt response-code 0) - (?1 ; Input required - (elpher-with-clean-buffer - (insert "Gemini server is requesting input.")) - (let* ((query-string (read-string (concat meta ": "))) - (url (elpher-address-to-url (elpher-node-address elpher-current-node))) - (query-address (elpher-address-from-url (concat url "?" query-string)))) - (elpher-get-gemini query-address #'elpher-process-gemini-response))) - (?2 ; Normal response - (message elpher-gemini-response-header) - (elpher-render-gemini-response meta)) - (?3 ; Redirect - (message "Following redirect to %s" meta) - (let ((redirect-address (elpher-address-from-gemini-url meta))) - (elpher-get-gemini redirect-address #'elpher-process-gemini-response))) - (?4 ; Temporary failure - (error "Gemini server reports TEMPORARY FAILURE for this request")) - (?5 ; Permanent failure - (error "Gemini server reports PERMANENT FAILURE for this request")) - (?6 ; Client certificate required - (error "Gemini server requires client certificate (unsupported at this time)")) - (other - (error "Gemini server responded with unknown response code %S" - response-code))))) - (error - (elpher-network-error (elpher-node-address elpher-current-node) the-error)))) - - -(defun elpher-get-gemini-node () - "Getter which retrieves and renders a Gemini node." - (let* ((address (elpher-node-address elpher-current-node)) - (content (elpher-get-cached-content address))) - (condition-case the-error - (if content - (progn - (elpher-with-clean-buffer - (insert content) - (elpher-restore-pos))) - (elpher-with-clean-buffer - (insert "LOADING GEMINI... (use 'u' to cancel)")) - (elpher-get-gemini address #'elpher-process-gemini-response)) - (error - (elpher-network-error address the-error))))) - - - - ;; Other URL node opening -(defun elpher-get-other-url-node () - "Getter which attempts to open the URL specified by the current node." +(defun elpher-get-other-url-node (renderer) + "Getter which attempts to open the URL specified by the current node (RENDERER must be nil)." + (when renderer + (elpher-visit-parent-node) + (error "Command not supported for general URLs")) (let* ((address (elpher-node-address elpher-current-node)) (url (elpher-address-to-url address))) (progn @@ -992,8 +922,11 @@ up to the calling function." ;; Telnet node connection -(defun elpher-get-telnet-node () - "Getter which opens a telnet connection to the server specified by the current node." +(defun elpher-get-telnet-node (renderer) + "Opens a telnet connection to the current node address (RENDERER must be nil)." + (when renderer + (elpher-visit-parent-node) + (error "Command not supported for telnet URLs")) (let* ((address (elpher-node-address elpher-current-node)) (host (elpher-address-host address)) (port (elpher-address-port address))) @@ -1002,8 +935,11 @@ up to the calling function." ;; Start page node retrieval -(defun elpher-get-start-node () - "Getter which displays the start page." +(defun elpher-get-start-node (renderer) + "Getter which displays the start page (RENDERER must be nil)." + (when renderer + (elpher-visit-parent-node) + (error "Command not supported for start page.")) (elpher-with-clean-buffer (insert " --------------------------------------------\n" " Elpher Gopher Client \n" @@ -1056,8 +992,11 @@ up to the calling function." ;; Bookmarks page node retrieval -(defun elpher-get-bookmarks-node () - "Getter to load and display the current bookmark list." +(defun elpher-get-bookmarks-node (renderer) + "Getter to load and display the current bookmark list (RENDERER must be nil)." + (when renderer + (elpher-visit-parent-node) + (error "Command not supported for bookmarks page.")) (elpher-with-clean-buffer (insert "---- Bookmark list ----\n\n") (let ((bookmarks (elpher-load-bookmarks))) @@ -1169,7 +1108,7 @@ If ADDRESS is already bookmarked, update the label only." (interactive) (let ((address (elpher-node-address elpher-current-node))) (if (elpher-address-special-p address) - (error "Command not valid for this page") + (error "Command invalid for this page") (let ((url (read-string "Gopher or Gemini URL: " (elpher-address-to-url address)))) (elpher-visit-node (elpher-make-node url (elpher-address-from-url url))))))) @@ -1205,7 +1144,7 @@ If ADDRESS is already bookmarked, update the label only." (if (elpher-address-special-p (elpher-node-address elpher-current-node)) (error "This page was not generated by a server") (elpher-visit-node elpher-current-node - #'elpher-get-node-raw)) + #'elpher-render-raw)) (message "No current site."))) (defun elpher-back () @@ -1222,21 +1161,23 @@ If ADDRESS is already bookmarked, update the label only." (if button (let ((node (button-get button 'elpher-node))) (if (elpher-address-special-p (elpher-node-address node)) - (error "Cannot download this link") + (error "Cannot download %s" + (elpher-node-display-string node)) (elpher-visit-node (button-get button 'elpher-node) - #'elpher-get-node-download))) + #'elpher-render-download))) (error "No link selected")))) (defun elpher-download-current () "Download the current page." (interactive) (if (elpher-address-special-p (elpher-node-address elpher-current-node)) - (error "Cannot download this page") + (error "Cannot download %s" + (elpher-node-display-string elpher-current-node)) (elpher-visit-node (elpher-make-node (elpher-node-display-string elpher-current-node) (elpher-node-address elpher-current-node) elpher-current-node) - #'elpher-get-node-download + #'elpher-render-download t))) (defun elpher-build-link-map () @@ -1276,7 +1217,7 @@ If ADDRESS is already bookmarked, update the label only." (elpher-visit-node (elpher-make-node (elpher-address-to-url address-copy) address-copy)))) - (error "Command invalid for this page")))) + (error "Command invalid for %s" (elpher-node-display-string elpher-current-node))))) (defun elpher-bookmarks-current-p () "Return non-nil if current node is a bookmarks page." @@ -1424,8 +1365,8 @@ If ADDRESS is already bookmarked, update the label only." (define-key map (kbd "X") 'elpher-unbookmark-current) (define-key map (kbd "B") 'elpher-bookmarks) (define-key map (kbd "S") 'elpher-set-coding-system) - (when (fboundp 'evil-define-key) - (evil-define-key 'motion map + (when (fboundp 'evil-mode) + (evil-define-key* 'motion map (kbd "TAB") 'elpher-next-link (kbd "C-") 'elpher-follow-current-link (kbd "C-t") 'elpher-back @@ -1453,7 +1394,7 @@ If ADDRESS is already bookmarked, update the label only." "Keymap for gopher client.") (define-derived-mode elpher-mode special-mode "elpher" - "Major mode for elpher, an elisp gopher client.) + "Major mode for elpher, an elisp gopher client.))))))) This mode is automatically enabled by the interactive functions which initialize the gopher client, namely