X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=bb1bc48b4ef898532a041d3feea64bc799024650;hb=25c0852cea9617041acb6a499c92d35b007a8370;hp=56f8e9bc1e0b36dffbac3a39c7eb3e0d74d35413;hpb=a19d312db54c43d354530177ce75f578394bf2e9;p=elpher.git diff --git a/elpher.el b/elpher.el index 56f8e9b..bb1bc48 100644 --- a/elpher.el +++ b/elpher.el @@ -4,7 +4,7 @@ ;; Author: Tim Vaughan ;; Created: 11 April 2019 -;; Version: 1.4.7 +;; Version: 2.0.0 ;; Keywords: comm gopher ;; Homepage: https://github.com/tgvaughan/elpher ;; Package-Requires: ((emacs "26")) @@ -83,7 +83,9 @@ ((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-url-node "htm" elpher-html) + ((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)) "Association list from types to getters, margin codes and index faces.") @@ -118,9 +120,17 @@ '((t :inherit warning)) "Face used for search type directory records.") -(defface elpher-url +(defface elpher-html '((t :inherit font-lock-comment-face)) - "Face used for url type directory records.") + "Face used for html type directory records.") + +(defface elpher-gemini + '((t :inherit font-lock-function-name-face)) + "Face used for html type directory records.") + +(defface elpher-other-url + '((t :inherit font-lock-comment-face)) + "Face used for other URL type links records.") (defface elpher-telnet '((t :inherit font-lock-function-name-face)) @@ -179,31 +189,42 @@ allows switching from an encrypted channel back to plain text without user input (let ((data (match-data))) ; Prevent parsing clobbering match data (unwind-protect (let ((url (url-generic-parse-url url-string))) - (if (and (url-type url) - (url-host url)) - (let ((is-gopher (or (equal "gopher" (url-type url)) - (equal "gophers" (url-type url))))) - (setf (url-filename url) - (url-unhex-string (url-filename url))) - (when (string-empty-p (url-filename url)) - (if is-gopher - (setf (url-filename url) "1"))) - (unless (> (url-port url) 0) - (if is-gopher - (setf (url-port url) 70))) - url) - (error "Malformed URL" url))) + (setf (url-fullness url) t) + (setf (url-filename url) + (url-unhex-string (url-filename url))) + (unless (url-type url) + (setf (url-type url) "gopher")) + (let ((is-gopher (or (equal "gopher" (url-type url)) + (equal "gophers" (url-type url)))) + (is-gemini (equal "gemini" (url-type url)))) + (when is-gopher + ;; Gopher defaults + (unless (url-host url) + (setf (url-host url) (url-filename url)) + (setf (url-filename url) "")) + (when (or (equal (url-filename url) "") + (equal (url-filename url) "/")) + (setf (url-filename url) "/1")) + (unless (> (url-port url) 0) + (setf (url-port url) 70))) + (when is-gemini + (unless (> (url-port url) 0) + (setf (url-port url) 1965)))) + url) (set-match-data data)))) (defun elpher-make-gopher-address (type selector host port &optional tls) "Create an ADDRESS object corresponding to the given gopher directory record attributes: TYPE, SELECTOR, HOST and PORT." - (elpher-address-from-url - (concat "gopher" (if tls "s" "") - "://" host - ":" (number-to-string port) - "/" (string type) - selector))) + (if (and (equal type ?h) + (string-prefix-p "URL:" selector)) + (elpher-address-from-url (elt (split-string selector "URL:") 1)) + (elpher-address-from-url + (concat "gopher" (if tls "s" "") + "://" host + ":" (number-to-string port) + "/" (string type) + selector)))) (defun elpher-make-special-address (type) "Create an ADDRESS object corresponding to the given special page symbol TYPE." @@ -223,8 +244,9 @@ attributes: TYPE, SELECTOR, HOST and PORT." (cond ((or (equal protocol "gopher") (equal protocol "gophers")) (list 'gopher (string-to-char (substring (url-filename address) 1)))) - ((string-equal protocol "gemini") - 'gemini))))) + ((equal protocol "gemini") + 'gemini) + (t 'other-url))))) (defun elpher-address-protocol (address) (if (symbolp address) @@ -250,7 +272,8 @@ attributes: TYPE, SELECTOR, HOST and PORT." (defun elpher-address-gopher-p (address) "Return non-nill if ADDRESS object is a gopher address." - (memq (elpher-address-protocol address) '("gopher gophers"))) + (and (not (elpher-address-special-p address)) + (member (elpher-address-protocol address) '("gopher gophers")))) (defun elpher-gopher-address-selector (address) "Retrieve gopher selector from ADDRESS object." @@ -335,9 +358,11 @@ unless PRESERVE-PARENT is non-nil." (elpher-visit-parent-node) (pcase type (`(gopher ,type-char) - (error "Unsupported gopher selector type '%c'" type-char)) + (error "Unsupported gopher selector type '%c' for '%s'" + type-char (elpher-address-to-url address))) (else - (error "Unsupported address type '%S'" type))))))) + (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." @@ -438,13 +463,7 @@ away CRs and any terminating period." (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))) - (if (equal (elpher-address-type address) '(gopher ?h)) - (let ((url (cadr (split-string (elpher-gopher-address-selector address) "URL:")))) - (format "mouse-1, RET: open url '%s'" url)) - (format "mouse-1, RET: open '%s' on %s port %s" - (elpher-gopher-address-selector address) - (elpher-address-host address) - (elpher-address-port address))))) + (format "mouse-1, RET: open '%s'" (elpher-address-to-url address)))) (defun elpher-insert-index-record (display-string address) "Function to insert an index record into the current buffer. @@ -482,6 +501,18 @@ The contents of the record are dictated by DISPLAY-STRING and ADDRESS." (elpher-visit-node node))) +;;; Network error reporting +;; + +(defun elpher-network-error (address error) + (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" + (propertize "\n----------------\n\n" 'face 'error) + "Press 'u' to return to the previous page."))) + + ;;; Gopher selector retrieval (all kinds) ;; @@ -573,50 +604,14 @@ up to the calling function." "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\|\[[a-zA-Z0-9:]+\]\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?" "Regexp used to locate and buttinofy URLs in text files loaded by elpher.") -(defun elpher-make-node-from-matched-url (&optional string) - "Convert most recent `elpher-url-regex' match to a node. - -If STRING is non-nil, this is given as an argument to all `match-string' -calls, as is necessary if the match is performed by `string-match'." - (let ((url (match-string 0 string)) - (protocol (downcase (match-string 1 string)))) - (if (or (string= protocol "gopher") - (string= protocol "gophers")) - (let* ((bare-host (match-string 2 string)) - (host (if (string-prefix-p "[" bare-host) - (substring bare-host 1 (- (length bare-host) 1)) - bare-host)) - (port (if (> (length (match-string 3 string)) 1) - (string-to-number (substring (match-string 3 string) 1)) - 70)) - (type-and-selector (match-string 4 string)) - (type (if (> (length type-and-selector) 1) - (elt type-and-selector 1) - ?1)) - (selector (decode-coding-string - (url-unhex-string - (if (> (length type-and-selector) 1) - (substring type-and-selector 2) - "")) 'utf-8)) - (use-tls (string= protocol "gophers")) - (address (elpher-make-gopher-address type selector host port use-tls))) - (elpher-make-node url address)) - (let* ((host (match-string 2 string)) - (port (if (> (length (match-string 3 string)) 1) - (string-to-number (substring (match-string 3 string) 1)) - 70)) - (selector (concat "URL:" url)) - (address (elpher-make-gopher-address ?h selector host port))) - (elpher-make-node url address))))) - - (defun elpher-buttonify-urls (string) "Turn substrings which look like urls in STRING into clickable buttons." (with-temp-buffer (insert string) (goto-char (point-min)) (while (re-search-forward elpher-url-regex nil t) - (let ((node (elpher-make-node-from-matched-url))) + (let ((node (elpher-make-node (match-string 0) + (elpher-address-from-url (match-string 0))))) (make-text-button (match-beginning 0) (match-end 0) 'elpher-node node @@ -748,7 +743,7 @@ calls, as is necessary if the match is performed by `string-match'." (error (error "Error downloading %s" elpher-download-filename)))))) -;; URL retrieval +;; HTML node retrieval (defun elpher-insert-rendered-html (string) "Use shr to insert rendered view of html STRING into current buffer." @@ -757,35 +752,220 @@ calls, as is necessary if the match is performed by `string-match'." (libxml-parse-html-region (point-min) (point-max))))) (shr-insert-document dom))) -(defun elpher-get-url-node () - "Getter which attempts to open the URL specified by the current node." +(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 ((url (elt (split-string selector "URL:") 1))) - (if url + (let ((content (elpher-get-cached-content address))) + (if content (progn - (elpher-visit-parent-node) ; Do first in case of non-local exits. - (message "Opening URL...") - (if elpher-open-urls-with-eww - (browse-web url) - (browse-url url))) - (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)))))))))))) + (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)))))))))) + +;; 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) + "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." + (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) + (proc (open-network-stream "elpher-process" + nil + (elpher-address-host address) + (elpher-address-port address) + :type 'tls))) + (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))))) + (set-process-sentinel proc after) + (process-send-string proc + (concat (elpher-address-to-url address) "\r\n"))))) + +(defun elpher-render-gemini-response (mime-type-raw) + (let* ((mime-type-full (if (string-empty-p mime-type-raw) + "text/gemini; charset=utf-8" + mime-type-raw)) + (mime-type-split (split-string mime-type-full ";")) + (mime-type (string-trim (elt mime-type-split 0))) + (parameters (if (> (length mime-type-split) 1) + (string-trim (elt mime-type-split 1)) + ""))) + (message "MIME type %S" mime-type) + (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-gemini-get-link-url (line) + (string-trim (elt (split-string (substring line 2)) 0))) + +(defun elpher-gemini-get-link-display-string (line) + (let* ((rest (string-trim (elt (split-string line "=>") 1))) + (idx (string-match "[ \t]" rest))) + (if idx + (string-trim (substring rest (+ idx 1))) + ""))) + +(defun elpher-address-from-gemini-url (url) + (let ((address (url-generic-parse-url url))) + (setf (url-fullness address) t) + (unless (url-host address) + (setf (url-host address) (url-host (elpher-node-address elpher-current-node))) + (unless (string-prefix-p "/" (url-filename address)) + (setf (url-filename address) + (concat (file-name-as-directory + (url-filename (elpher-node-address elpher-current-node))) + (url-filename address))))) + (unless (url-type address) + (setf (url-type address) "gemini")) + (unless (> (url-port address) 0) + (pcase (url-type address) + ("gemini" (setf (url-port address) 1965)) + ("gopher" (setf (url-port address) 70)))) + address)) + +(defun elpher-render--mimetype-text/gemini (data parameters) + (elpher-with-clean-buffer + (dolist (line (split-string (elpher-preprocess-text-response data) "\n")) + (if (string-prefix-p "=>" line) + (let* ((url (elpher-gemini-get-link-url line)) + (display-string (elpher-gemini-get-link-display-string line)) + (address (elpher-address-from-gemini-url url))) + (if (> (length display-string) 0) + (elpher-insert-index-record display-string address) + (elpher-insert-index-record url address))) + (insert (elpher-buttonify-urls line) "\n"))) + (elpher-restore-pos) + (elpher-cache-content + (elpher-node-address elpher-current-node) + (buffer-string)))) + +(defun elpher-render--mimetype-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 + (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." + (let* ((address (elpher-node-address elpher-current-node)) + (url (elpher-address-to-url address))) + (progn + (elpher-visit-parent-node) ; Do first in case of non-local exits. + (message "Opening URL...") + (if elpher-open-urls-with-eww + (browse-web url) + (browse-url url))))) ;; Telnet node connection @@ -861,7 +1041,7 @@ calls, as is necessary if the match is performed by `string-match'." (if bookmarks (dolist (bookmark bookmarks) (let ((display-string (elpher-bookmark-display-string bookmark)) - (address (elpher-bookmark-address bookmark))) + (address (elpher-address-from-url (elpher-bookmark-url bookmark)))) (elpher-insert-index-record display-string address))) (insert "No bookmarks found.\n"))) (insert "\n-----------------------\n\n" @@ -952,21 +1132,12 @@ If ADDRESS is already bookmarked, update the label only." (push-button)) (defun elpher-go () - "Go to a particular gopher site read from the minibuffer. -The site may be specified via a URL or explicitly in terms of -host, selector and port." + "Go to a particular gopher site read from the minibuffer." (interactive) (let ((node - (let ((host-or-url (read-string "Gopher host or URL: "))) - (if (string-match elpher-url-regex host-or-url) - (elpher-make-node-from-matched-url host-or-url) - (let ((selector (read-string "Selector (default none): " nil nil "")) - (port-string (read-string "Port (default 70): " nil nil "70"))) - (elpher-make-node (concat "gopher://" host-or-url - ":" port-string - "/1" selector) - (elpher-make-gopher-address ?1 selector host-or-url - (string-to-number port-string)))))))) + (let ((host-or-url (read-string "Gopher or Gemini URL: "))) + (elpher-make-node host-or-url + (elpher-address-from-url host-or-url))))) (switch-to-buffer "*elpher*") (elpher-visit-node node))) @@ -976,12 +1147,8 @@ host, selector and port." (let ((address (elpher-node-address elpher-current-node))) (if (elpher-address-special-p address) (error "Command not valid for this page") - (let ((url (read-string "URL: " (elpher-address-to-url address)))) - (if (string-match elpher-url-regex url) - (let ((new-node (elpher-make-node-from-matched-url url))) - (unless (equal (elpher-node-address new-node) address) - (elpher-visit-node new-node))) - (error "Could not parse URL %s" url)))))) + (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))))))) (defun elpher-redraw () "Redraw current page." @@ -1074,20 +1241,18 @@ host, selector and port." (defun elpher-root-dir () "Visit root of current server." (interactive) - (let* ((address (elpher-node-address elpher-current-node)) - (host (elpher-address-host address))) - (if host - (let ((host (elpher-address-host address)) - (selector (elpher-gopher-address-selector address)) - (port (elpher-address-port address))) - (if (> (length selector) 0) - (let ((root-address (elpher-make-gopher-address ?1 "" host port))) - (elpher-visit-node - (elpher-make-node (concat "gopher://" host - ":" (number-to-string port) - "/1/") - root-address))) - (error "Already at root directory of current server"))) + (let ((address (elpher-node-address elpher-current-node))) + (if (not (elpher-address-special-p address)) + (if (or (member (url-filename address) '("/" "")) + (and (elpher-address-gopher-p address) + (= (length (elpher-gopher-address-selector address)) 0))) + (error "Already at root directory of current server") + (let ((address-copy (elpher-address-from-url + (elpher-address-to-url address)))) + (setf (url-filename address-copy) "") + (elpher-visit-node + (elpher-make-node (elpher-address-to-url address-copy) + address-copy)))) (error "Command invalid for this page")))) (defun elpher-bookmarks-current-p () @@ -1159,12 +1324,9 @@ host, selector and port." "Display information on NODE." (let ((display-string (elpher-node-display-string node)) (address (elpher-node-address node))) - (if (not (elpher-address-special-p address)) - (message "`%s' on %s port %s" - (elpher-gopher-address-selector address) - (elpher-address-host address) - (elpher-address-port address)) - (message "%s" display-string)))) + (if (elpher-address-special-p address) + (message "Special page: %s" display-string) + (message (elpher-address-to-url address))))) (defun elpher-info-link () "Display information on node corresponding to link at point." @@ -1245,7 +1407,6 @@ host, selector and port." (kbd "C-") 'elpher-follow-current-link (kbd "C-t") 'elpher-back (kbd "u") 'elpher-back - (kbd "O") 'elpher-root-dir (kbd "g") 'elpher-go (kbd "o") 'elpher-go-current (kbd "r") 'elpher-redraw @@ -1269,7 +1430,7 @@ host, selector and port." "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