;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 3.3.3
+;; Version: 3.4.1
;; Keywords: comm gopher
;; Homepage: https://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "27.1"))
;;; Global constants
;;
-(defconst elpher-version "3.3.3"
+(defconst elpher-version "3.4.1"
"Current version of elpher.")
(defconst elpher-margin-width 6
((gopher ?s) elpher-get-gopher-page elpher-render-download "snd" elpher-binary)
((gopher ?h) elpher-get-gopher-page elpher-render-html "htm" elpher-html)
(gemini elpher-get-gemini-page elpher-render-gemini "gem" elpher-gemini)
+ (spartan elpher-get-spartan-page elpher-render-gemini "spt" elpher-spartan)
(finger elpher-get-finger-page elpher-render-text "txt" elpher-text)
(telnet elpher-get-telnet-page nil "tel" elpher-telnet)
(other-url elpher-get-other-url-page nil "url" elpher-other-url)
'((t :inherit font-lock-constant-face))
"Face used for Gemini type directory records.")
+(defface elpher-spartan
+ '((t :inherit font-lock-type-face))
+ "Face used for Spartan type directory records.")
+
+(defface elpher-spartan-post
+ '((t :inherit font-lock-string-face))
+ "Face used for Spartan type directory records.")
+
(defface elpher-other-url
'((t :inherit font-lock-comment-face))
"Face used for other URL type links records.")
'((t :inherit bold :height 1.2))
"Face used for gemini heading level 3.")
-(defface elpher-gemini-preformatted
- '((t :inherit fixed-pitch))
- "Face used for pre-formatted gemini text blocks.")
-
(defface elpher-gemini-quoted
'((t :inherit font-lock-doc-face))
"Face used for gemini quoted texts.")
(when (or (equal (url-filename url) "")
(equal (url-filename url) "/"))
(setf (url-filename url) "/1")))
- (when (equal "gemini" (url-type url))
- ;; Gemini defaults
+ (when (member (url-type url) '("gemini" "spartan"))
+ ;; Gemini and Spartan defaults
(if (equal (url-filename url) "")
(setf (url-filename url) "/"))))
(elpher-remove-redundant-ports url))
?1
(string-to-char (substring (url-filename address) 1)))))
("gemini" 'gemini)
+ ("spartan" 'spartan)
("telnet" 'telnet)
("finger" 'finger)
("file" 'file)
(defun elpher-gemini-get-link-display-string (link-line)
"Extract the display string portion of LINK-LINE, a gemini map file link line.
Return nil if this portion is not provided."
- (let* ((rest (string-trim (elt (split-string link-line "=>") 1)))
+ (let* ((rest (string-trim (substring link-line 2)))
(idx (string-match "[ \t]" rest)))
(and idx
(elpher-color-filter-apply (string-trim (substring rest (+ idx 1)))))))
(setf (url-host address) (puny-encode-domain (url-host address))))
(unless (url-type address)
(setf (url-type address) (url-type current-address)))
- (when (equal (url-type address) "gemini")
+ (when (member (url-type address) '("gemini" "spartan"))
(setf (url-filename address)
(elpher-collapse-dot-sequences (url-filename address)))))
(elpher-remove-redundant-ports address)))
PREF-ID is the value assigned to the \"invisible\" text attribute, which
can be used to toggle the display of the preformatted text."
(insert (propertize (concat (elpher-process-text-for-display line) "\n")
- 'face 'elpher-gemini-preformatted
'invisible pref-id
'rear-nonsticky t)))
(elpher-gemini-insert-preformatted-line line preformatted))
((pred (string-prefix-p "=>"))
(elpher-gemini-insert-link line))
+ ((pred (string-prefix-p "=:"))
+ (elpher-spartan-insert-query line))
((pred (string-prefix-p "#"))
(elpher-gemini-insert-header line))
(_ (elpher-gemini-insert-text line))))
(reverse headers))))
+;; Spartan page retrieval
+
+(defvar elpher-spartan-redirect-chain)
+
+(defun elpher-get-spartan-page (renderer)
+ "Getter which retrieves and renders a Spartan page and renders it using RENDERER."
+ (let* ((address (elpher-page-address elpher-current-page))
+ (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 SPARTAN... (use 'u' to cancel)\n"))
+ (setq elpher-spartan-redirect-chain nil)
+ (elpher-get-spartan-response address renderer))
+ (error
+ (elpher-network-error address the-error)))))
+
+(defun elpher-get-spartan-response (address renderer)
+ "Get response string from spartan server at ADDRESS and render using RENDERER."
+ (let* ((host (elpher-address-host address))
+ (path-and-query (url-path-and-query address))
+ (filename (car path-and-query))
+ (data (cdr path-and-query))
+ (data-len (length data)))
+ (elpher-get-host-response address 300
+ (concat host " "
+ filename " "
+ (number-to-string data-len) "\r\n"
+ data)
+ (lambda (response-string)
+ (elpher-process-spartan-response response-string renderer)))))
+
+(defun elpher-parse-spartan-response (response)
+ "Parse the RESPONSE string and return a list of components.
+The list is of the form (code meta body). A response of nil implies
+that the response was malformed."
+ (let ((header-end-idx (string-match "\r\n" response)))
+ (if header-end-idx
+ (let ((header (string-trim (substring response 0 header-end-idx)))
+ (body (substring response (+ header-end-idx 2))))
+ (if (>= (length header) 2)
+ (let ((code (substring header 0 1))
+ (meta (string-trim (substring header 1))))
+ (list code meta body))
+ (error "Malformed response: No response status found in header %s" header)))
+ (error "Malformed response: No CRLF-delimited header found in response %s" response))))
+
+(defun elpher-process-spartan-response (response-string renderer)
+ "Process the spartan response RESPONSE-STRING and pass the result to RENDERER."
+ (let ((response-components (elpher-parse-spartan-response response-string)))
+ (let ((response-code (elt response-components 0))
+ (response-meta (elt response-components 1))
+ (response-body (elt response-components 2)))
+ (pcase (elt response-code 0)
+ (?2 ; Normal response
+ (funcall renderer response-body response-meta))
+ (?3 ; Redirect
+ (message "Following redirect to %s" response-meta)
+ (if (>= (length elpher-spartan-redirect-chain) 5)
+ (error "More than 5 consecutive redirects followed"))
+ (let* ((current-address (elpher-page-address elpher-current-page))
+ (redirect-address (elpher-address-from-url
+ (concat "spartan://"
+ (elpher-address-host current-address)
+ ":"
+ (elpher-address-port current-address)
+ "/"
+ response-meta))))
+ (if (member redirect-address elpher-spartan-redirect-chain)
+ (error "Redirect loop detected"))
+ (elpher-page-set-address elpher-current-page redirect-address)
+ (add-to-list 'elpher-spartan-redirect-chain redirect-address)
+ (elpher-get-spartan-response redirect-address renderer)))
+ (?4 ; Client error
+ (error "Spartan server reports CLIENT ERROR for this request: %s %s"
+ response-code response-meta))
+ (?5 ; Server error
+ (error "Spartan server reports SERVER ERROR for this request: %s %s"
+ response-code response-meta))
+ (_other
+ (error "Spartan server response unknown: %s %s"
+ response-code response-meta))))))
+
+(defun elpher-spartan-insert-query (query-line)
+ "Insert link described by QUERY-LINE into a text/gemini document."
+ (let ((url (elpher-gemini-get-link-url query-line)))
+ (when url
+ (let* ((address (elpher-address-from-gemini-url url))
+ (given-display-string (elpher-gemini-get-link-display-string query-line))
+ (fill-prefix (make-string (+ 1 (length elpher-gemini-link-string)) ?\s)))
+ (insert elpher-gemini-link-string)
+ (let ((display-string (or given-display-string url)))
+ (insert-text-button display-string
+ 'face 'elpher-spartan-post
+ 'display-string display-string
+ 'url (elpher-address-to-url address)
+ 'action #'elpher-spartan-post
+ 'follow-link t
+ 'help-echo #'elpher--page-button-help))
+ (newline)))))
+
+(defun elpher-spartan-post (button)
+ "Function called when the spartan post link BUTTON is clicked."
+ (let* ((display-string (button-get button 'display-string))
+ (url (button-get button 'url))
+ (post-url (concat url "?" (url-hexify-string (read-string "Text to post: ")))))
+ (elpher-visit-page (elpher-make-page
+ display-string
+ (elpher-address-from-url post-url)))))
+
;; Finger page connection
(defun elpher-get-finger-page (renderer)
'help-echo help-string))
(insert "\n")
(insert (propertize
- (concat "(These documents should be available if you have installed Elpher \n"
- " using MELPA. Otherwise you may have to install the manual yourself.)\n")
+ (concat "(These documents should be available if you have installed Elpher\n"
+ " from MELPA or non-GNU ELPA. Otherwise you may have to install the\n"
+ " manual yourself.)\n")
'face 'shadow))
(elpher-restore-pos)))
The Lambda Lab / projects / elpher.git / blobdiff