;; Author: Tim Vaughan <tgvaughan@gmail.com>
;; Created: 11 April 2019
-;; Version: 2.0.1
+;; Version: 2.3.3
;; Keywords: comm gopher
;; Homepage: https://github.com/tgvaughan/elpher
;; Package-Requires: ((emacs "26"))
;;; Global constants
;;
-(defconst elpher-version "2.0.1"
+(defconst elpher-version "2.3.3"
"Current version of elpher.")
(defconst elpher-margin-width 6
((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 ?9) elpher-get-gopher-node elpher-render-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)
Otherwise, use the system browser via the BROWSE-URL function."
:type '(boolean))
-(defcustom elpher-buttonify-urls-in-directories nil
+(defcustom elpher-buttonify-urls-in-directories t
"If non-nil, turns URLs matched in directories into clickable buttons."
:type '(boolean))
(let ((data (match-data))) ; Prevent parsing clobbering match data
(unwind-protect
(let ((url (url-generic-parse-url url-string)))
- (setf (url-fullness url) t)
- (setf (url-filename url)
- (url-unhex-string (url-filename url)))
- (unless (url-type url)
- (setf (url-type url) "gopher"))
- (when (or (equal "gopher" (url-type url))
- (equal "gophers" (url-type url)))
+ (unless (and (not (url-fullness url)) (url-type 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"))
+ (when (or (equal "gopher" (url-type url))
+ (equal "gophers" (url-type url)))
;; Gopher defaults
(unless (url-host url)
(setf (url-host url) (url-filename url))
(when (or (equal (url-filename url) "")
(equal (url-filename url) "/"))
(setf (url-filename url) "/1")))
+ (when (equal "gemini" (url-type url))
+ ;; Gemini defaults
+ (if (equal (url-filename url) "")
+ (setf (url-filename url) "/"))))
url)
(set-match-data data))))
The basic attributes include: TYPE, SELECTOR, HOST and PORT.
If the optional attribute TLS is non-nil, the address will be marked as
requiring gopher-over-TLS."
- (if (and (equal type ?h)
- (string-prefix-p "URL:" selector))
- (elpher-address-from-url (elt (split-string selector "URL:") 1))
+ (cond
+ ((and (equal type ?h)
+ (string-prefix-p "URL:" selector))
+ (elpher-address-from-url (elt (split-string selector "URL:") 1)))
+ ((equal type ?8)
+ (elpher-address-from-url
+ (concat "telnet"
+ "://" host
+ ":" (number-to-string port))))
+ (t
(elpher-address-from-url
(concat "gopher" (if tls "s" "")
"://" host
":" (number-to-string port)
"/" (string type)
- selector))))
+ selector)))))
(defun elpher-make-special-address (type)
"Create an ADDRESS object corresponding to the given special page symbol TYPE."
nil))
(defun elpher-address-type (address)
- "Retrieve selector type from ADDRESS object."
+ "Retrieve type of ADDRESS object.
+This is used to determine how to retrieve and render the document the
+address refers to, via the table `elpher-type-map'."
(if (symbolp address)
(list 'special address)
(let ((protocol (url-type address)))
(string-to-char (substring (url-filename address) 1)))))
((equal protocol "gemini")
'gemini)
+ ((equal protocol "telnet")
+ 'telnet)
(t 'other-url)))))
(defun elpher-address-protocol (address)
(defun elpher-address-port (address)
"Retrieve port from ADDRESS object."
- (url-port address))
+ (if (symbolp address)
+ nil)
+ (if (> (url-port address) 0)
+ (url-port address)
+ (or (and (or (equal (url-type address) "gopher")
+ (equal (url-type address) "gophers"))
+ 70)
+ (and (equal (url-type address) "gemini")
+ 1965))))
(defun elpher-address-special-p (address)
"Return non-nil if ADDRESS object is special (e.g. start page, bookmarks page)."
(defun elpher-update-header ()
"If `elpher-use-header' is true, display current node info in window header."
(if elpher-use-header
- (setq header-line-format (elpher-node-display-string elpher-current-node))))
+ (let* ((display-string (elpher-node-display-string elpher-current-node))
+ (address (elpher-node-address elpher-current-node))
+ (url-string (if (elpher-address-special-p address)
+ ""
+ (concat " - " (elpher-address-to-url address) "")))
+ (header (replace-regexp-in-string "%" "%%" (concat display-string
+ url-string))))
+ (setq header-line-format header))))
(defmacro elpher-with-clean-buffer (&rest args)
"Evaluate ARGS with a clean *elpher* buffer as current."
(proc (open-network-stream "elpher-process"
nil
(elpher-address-host address)
- (if (> (elpher-address-port address) 0)
- (elpher-address-port address)
- 70)
+ (elpher-address-port address)
:type (if elpher-use-tls 'tls 'plain))))
(set-process-coding-system proc 'binary)
(set-process-filter proc
(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)))
+ (let ((propertized-display-string
+ (propertize display-string 'face 'elpher-info)))
+ (insert (if elpher-buttonify-urls-in-directories
+ (elpher-buttonify-urls propertized-display-string)
+ propertized-display-string))))
(`(gopher ,selector-type) ;; Unknown
(elpher-insert-margin (concat (char-to-string selector-type) "?"))
(insert (propertize display-string
(elpher-visit-node node)))
(defun elpher-render-index (data &optional _mime-type-string)
- "Render DATA as an index."
+ "Render DATA as an index. MIME-TYPE-STRING is unused."
(elpher-with-clean-buffer
(if (not data)
t
;; 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\-]\\|\[[a-zA-Z0-9:]+\]\\)\\(:[0-9]+\\)?\\(/\\([0-9a-zA-Z\-_~?/@|:.]*[0-9a-zA-Z\-_~?/@|]\\)?\\)?"
"Regexp used to locate and buttniofy URLs in text files loaded by elpher.")
(defun elpher-buttonify-urls (string)
'elpher-node node
'action #'elpher-click-link
'follow-link t
- 'help-echo (elpher-node-button-help node))))
+ 'help-echo (elpher-node-button-help node)
+ 'face 'button)))
(buffer-string)))
(defun elpher-render-text (data &optional _mime-type-string)
- "Render DATA as text."
+ "Render DATA as text. MIME-TYPE-STRING is unused."
(elpher-with-clean-buffer
(if (not data)
t
;; Image retrieval
(defun elpher-render-image (data &optional _mime-type-string)
- "Display DATA as image."
+ "Display DATA as image. MIME-TYPE-STRING is unused."
(if (not data)
nil
(if (display-images-p)
;; Raw server response rendering
(defun elpher-render-raw (data &optional _mime-type-string)
- "Display raw DATA in buffer."
+ "Display raw DATA in buffer. MIME-TYPE-STRING is unused."
(if (not data)
nil
(elpher-with-clean-buffer
;; File save "rendering"
(defun elpher-render-download (data &optional _mime-type-string)
- "Save DATA to file."
+ "Save DATA to file. MIME-TYPE-STRING is unused."
(if (not data)
nil
(let* ((address (elpher-node-address elpher-current-node))
;; HTML rendering
(defun elpher-render-html (data &optional _mime-type-string)
- "Render DATA as HTML using shr."
+ "Render DATA as HTML using shr. MIME-TYPE-STRING is unused."
(elpher-with-clean-buffer
(if (not data)
t
(setq elpher-gemini-response "")
(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)
- (if (> (elpher-address-port address) 0)
+ (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)
- 1965)
- :type 'tls)))
- (set-process-coding-system proc 'binary)
- (set-process-filter proc
- (lambda (_proc 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")))))
+ :type 'tls)))
+ (set-process-coding-system proc 'binary)
+ (set-process-filter proc
+ (lambda (_proc 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")))
+ (error
+ (error "Error initiating connection to server")))))
+
+(defun elpher-parse-gemini-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 2))
+ (meta (string-trim (substring header 2))))
+ (list code meta body))
+ (error "Malformed response: No response status found in header %s" header)))
+ (error "Malformed response: No CRLF-delimited header found"))))
(defun elpher-process-gemini-response (renderer)
"Process the gemini response and pass the result to RENDERER.
The response is assumed to be in the variable `elpher-gemini-response'."
(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))))
+ (let ((response-components (elpher-parse-gemini-response elpher-gemini-response)))
+ (let ((response-code (elt response-components 0))
+ (response-meta (elt response-components 1))
+ (response-body (elt response-components 2)))
+ (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: %s %s"
+ response-code response-meta))
+ (?5 ; Permanent failure
+ (error "Gemini server reports PERMANENT FAILURE for this request: %s %s"
+ response-code response-meta))
+ (?6 ; Client certificate required
+ (error "Gemini server requires client certificate (unsupported at this time)"))
+ (_other
+ (error "Gemini server response unknown: %s %s"
+ response-code response-meta)))))
(error
(elpher-network-error (elpher-node-address elpher-current-node) the-error))))
(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 body (decode-coding-string body
- (intern (cadr (assoc "charset" parameters))))))
+ (setq body (decode-coding-string
+ body
+ (if (assoc "charset" parameters)
+ (intern (cadr (assoc "charset" parameters)))
+ 'utf-8)))
(setq body (replace-regexp-in-string "\r" "" body)))
(pcase mime-type
((or "text/gemini" "")
(let ((address (url-generic-parse-url url)))
(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
+ (unless (url-host address) ;if there is an explicit host, filenames are absolute
(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)
(buffer-string))))
(defun elpher-render-gemini-plain-text (data _parameters)
- "Render DATA as plain text file."
+ "Render DATA as plain text file. PARAMETERS is currently unused."
(elpher-with-clean-buffer
(insert (elpher-buttonify-urls data))
(elpher-cache-content
" - TAB/Shift-TAB: next/prev item on current page\n"
" - RET/mouse-1: open item under cursor\n"
" - m: select an item on current page by name (autocompletes)\n"
- " - u: return to previous page\n"
+ " - u/mouse-3: return to previous page\n"
" - o/O: visit different selector or the root menu of the current server\n"
" - g: go to a particular gopher address\n"
" - d/D: download item under cursor or current page\n"
(define-key map (kbd "TAB") 'elpher-next-link)
(define-key map (kbd "<backtab>") 'elpher-prev-link)
(define-key map (kbd "u") 'elpher-back)
+ (define-key map [mouse-3] 'elpher-back)
(define-key map (kbd "O") 'elpher-root-dir)
(define-key map (kbd "g") 'elpher-go)
(define-key map (kbd "o") 'elpher-go-current)
(kbd "C-") 'elpher-follow-current-link
(kbd "C-t") 'elpher-back
(kbd "u") 'elpher-back
+ [mouse-3] 'elpher-back
(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