((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)
- (other-url elpher-get-url-node "url" 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.")
'((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))
(unwind-protect
(let ((url (url-generic-parse-url url-string)))
(setf (url-fullness url) t)
- (unless (url-host url)
- (setf (url-host url) (url-filename url))
- (setf (url-filename url) ""))
+ (setf (url-filename url)
+ (url-unhex-string (url-filename url)))
(unless (url-type url)
(setf (url-type url) "gopher"))
- (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 (or (equal (url-filename url) "")
- (equal (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)))
+ (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)
(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-get-gemini (address after &optional propagate-error)
+ "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"))
+ (condition-case the-error
+ (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")))
+ (error
+ (elpher-process-cleanup)
+ (if propagate-error
+ (error the-error)
+ (elpher-with-clean-buffer
+ (insert (propertize "\n---- ERROR -----\n\n" 'face 'error)
+ "Failed to connect to " (elpher-address-to-url address) ".\n"
+ (propertize "\n----------------\n\n" 'face 'error)
+ "Press 'u' to return to the previous page."))))))
+
+(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-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))
+ ("text/plain"
+ (elpher-render--mimetype-text/plain 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
+ (substring rest (+ idx 1))
+ "")))
+
+(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))
+ (address (url-generic-parse-url url))
+ (display-string (elpher-gemini-get-link-display-string line)))
+ (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))))
+ (if display-string
+ (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-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)))
+ (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
+ (lambda (proc event)
+ (unless (string-prefix-p "deleted" event)
+ (let ((response-code (elpher-gemini-response-code))
+ (meta (elpher-gemini-response-meta)))
+ (pcase (elt response-code 0)
+ (?2
+ (elpher-render-gemini-response meta))
+ (other
+ (error "Gemini server responded with response code %S"
+ response-code))))))))))
+
-;; URL node opening
+;; Other URL node opening
-(defun elpher-get-url-node ()
+(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)))
(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: ")))
+ (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*")
(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))))
+ (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 ()
(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
"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
The Lambda Lab / projects / elpher.git / blobdiff