"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.")
(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))))
+ (setf (url-filename url) "/1"))))
url)
(set-match-data data))))
(let ((protocol (url-type address)))
(cond ((or (equal protocol "gopher")
(equal protocol "gophers"))
- (list 'gopher (string-to-char (substring (url-filename address) 1))))
+ (list 'gopher
+ (if (member (url-filename address) '("" "/"))
+ ?1
+ (string-to-char (substring (url-filename address) 1)))))
((equal protocol "gemini")
'gemini)
(t 'other-url)))))
(defun elpher-gopher-address-selector (address)
"Retrieve gopher selector from ADDRESS object."
- (substring (url-filename address) 2))
+ (if (member (url-filename address) '("" "/"))
+ ""
+ (substring (url-filename address) 2)))
;; Node
(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)
(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."
(let ((address (elpher-node-address node)))
(format "mouse-1, RET: open '%s'" (elpher-address-to-url address))))
-(defun elpher-insert-index-record (display-string 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."
- (let* ((type (elpher-address-type address))
+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))
'follow-link t
'help-echo (elpher-node-button-help node)))
(pcase type
- ('(gopher ?i) ;; Information
+ ((or '(gopher ?i) 'nil) ;; Information
(elpher-insert-margin)
(insert (propertize
(if elpher-buttonify-urls-in-directories
(proc (open-network-stream "elpher-process"
nil
(elpher-address-host address)
- (elpher-address-port address)
+ (if (> (elpher-address-port address) 0)
+ (elpher-address-port address)
+ 70)
:type (if elpher-use-tls 'tls 'plain))))
(set-process-coding-system proc 'binary)
(set-process-filter proc
(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."
- (let* ((address (elpher-node-address elpher-current-node))
- (content (elpher-get-cached-content address)))
+(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)))
+ (funcall renderer nil 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)))))))
+
-;; Text retrieval
+;; Index node rendering
+
+(defun elpher-render-index (data &optional cached-data)
+ "Render DATA as an index, using CACHED-DATA instead if supplied."
+ (elpher-with-clean-buffer
+ (if cached-data
+ (insert cached-data)
+ (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(),]*\\)?"
+ "\\([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-buttonify-urls (string)
'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 cached-data)
+ "Render DATA as text, using CACHED-DATA instead if supplied."
+ (elpher-with-clean-buffer
+ (if cached-data
+ (insert cached-data)
+ (insert (elpher-buttonify-urls
+ (elpher-preprocess-text-response)
+ elpher-selector-string))
+ (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)))
- (if (display-images-p)
- (progn
+(defun elpher-render-image (data)
+ "Display DATA as image, using CACHED-DATA if supplied.
+If image display is unsupported, offer to save the image to a file."
+ (if (display-images-p)
+ (progn
+ (let ((image (create-image
+ data
+ nil t)))
(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))))
+ (insert-image image)
+ (elpher-restore-pos))))
+ (elpher-save-to-file data)))
;; Search retrieval
(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))))
(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)
+ (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))))))
(if aborted
(elpher-visit-parent-node))))))
(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’.
(proc (open-network-stream "elpher-process"
nil
(elpher-address-host address)
- (elpher-address-port address)
+ (if (> (elpher-address-port address) 0)
+ (elpher-address-port address)
+ 1965)
:type 'tls)))
(set-process-coding-system proc 'binary)
(set-process-filter proc
(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)
+
+(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))
"")))
(defun elpher-address-from-gemini-url (url)
+ "Extract address from URL with defaults as per gemini map files."
(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))))
+ (unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls
+ (setf (url-fullness address) t)
+ (unless (url-host address) ;if there is an explicit host, filenames are explicit
+ (setf (url-host address) (url-host (elpher-node-address elpher-current-node)))
+ (unless (string-prefix-p "/" (url-filename address)) ;deal with relative links
+ (setf (url-filename address)
+ (concat (file-name-directory
+ (url-filename (elpher-node-address elpher-current-node)))
+ (url-filename address)))))
+ (unless (url-type address)
+ (setf (url-type address) "gemini")))
address))
(defun elpher-render--mimetype-text/gemini (data parameters)
(elpher-with-clean-buffer
- (dolist (line (split-string (elpher-preprocess-text-response data) "\n"))
+ (dolist (line (split-string data "\n"))
(if (string-prefix-p "=>" line)
(let* ((url (elpher-gemini-get-link-url line))
(display-string (elpher-gemini-get-link-display-string line))
(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-insert-index-record line)))
(elpher-restore-pos)
(elpher-cache-content
(elpher-node-address elpher-current-node)
(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)))
+ (let ((response-code (car (split-string elpher-gemini-response-header)))
+ (meta (string-trim
+ (substring elpher-gemini-response-header
+ (string-match "[ \t]+"
+ elpher-gemini-response-header)))))
(pcase (elt response-code 0)
(?1 ; Input required
(elpher-with-clean-buffer
(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)
(error
(elpher-network-error address the-error)))))
-
-
;; Other URL node opening
The Lambda Lab / projects / elpher.git / blobdiff