-(defun elpher-get-node-download ()
- "Getter which retrieves the current node and writes the result to a file."
- (let* ((address (elpher-node-address elpher-current-node))
- (selector (elpher-gopher-address-selector address)))
- (elpher-visit-parent-node) ; Do first in case of non-local exits.
- (let* ((filename-proposal (file-name-nondirectory selector))
- (filename (read-file-name "Save file as: "
- nil nil nil
- (if (> (length filename-proposal) 0)
- filename-proposal
- "gopher.file"))))
- (message "Downloading...")
- (setq elpher-download-filename filename)
- (condition-case the-error
- (elpher-get-selector address
- (lambda (proc event)
- (let ((coding-system-for-write 'binary))
- (with-temp-file elpher-download-filename
- (insert elpher-selector-string)
- (message (format "Download complate, saved to file %s."
- elpher-download-filename)))))
- t)
- (error
- (error "Error downloading %s" elpher-download-filename))))))
+(defun elpher-render-html (data &optional cached-data)
+ "Render DATA as HTML using shr, or insert CACHED-DATA if non-nil."
+ (elpher-with-clean-buffer
+ (if cached-data
+ (progn (insert cached-data) t)
+ (let ((dom (with-temp-buffer
+ (insert string)
+ (libxml-parse-html-region (point-min) (point-max)))))
+ (shr-insert-document dom)))))
+
+;;;;;;;;; ONLY COMPLETED TO HERE ;;;;;;;;;;;;;;;;;;;;
+
+;; Gemini node retrieval
+
+(defvar elpher-gemini-response)
+
+(defun elpher-get-gemini (address after)
+ "Retrieve gemini ADDRESS, then execute AFTER.
+The response is stored in the variable ‘elpher-gemini-response’."
+ (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)
+ (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")))))
+
+
+(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))
+ ((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)
+ "Extract address from URL with defaults as per gemini map files."
+ (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
+ (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 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)))
+ (elpher-insert-index-record line)))
+ (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))))
The Lambda Lab / projects / elpher.git / blobdiff