X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=da4d11d845f281f49dce116666c93831296ea531;hb=251033288819389440383a5d823ea3fb9d2f2d97;hp=6cc34746e5feddc9694ac75cb1bd5ad2ae19af99;hpb=7c60d1ffd2e07b32d3904bab21debc288ed51d3d;p=elpher.git diff --git a/elpher.el b/elpher.el index 6cc3474..da4d11d 100644 --- a/elpher.el +++ b/elpher.el @@ -145,6 +145,11 @@ These certificates may be used for establishing authenticated TLS connections." "The command used to launch openssl when generating TLS client certificates." :type '(file)) +(defcustom elpher-default-url-type "gopher" + "Default URL type to assume if not explicitly given." + :type '(choice (const "gopher") + (const "gemini"))) + (defcustom elpher-gemini-TLS-cert-checks nil "If non-nil, verify gemini server TLS certs using the default security level. Otherwise, certificate verification is disabled. @@ -258,6 +263,10 @@ Otherwise, the SOCKS proxy is only used for connections to onion services." '((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.") + ;;; Model ;; @@ -278,13 +287,17 @@ Otherwise, the SOCKS proxy is only used for connections to onion services." (setf (url-filename url) (url-unhex-string (url-filename url))) (unless (url-type url) - (setf (url-type url) "gopher")) + (setf (url-type url) elpher-default-url-type)) + (unless (url-host url) + (let ((p (split-string (url-filename url) "/" nil nil))) + (setf (url-host url) (car p)) + (setf (url-filename url) + (if (cdr p) + (concat "/" (mapconcat #'identity (cdr p) "/")) + "")))) (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)) - (setf (url-filename url) "")) (when (or (equal (url-filename url) "") (equal (url-filename url) "/")) (setf (url-filename url) "/1"))) @@ -484,7 +497,7 @@ unless NO-HISTORY is non-nil." (if previous-page (elpher-visit-page previous-page nil t) (error "No previous page")))) - + (defun elpher-reload-current-page () "Reload the current page, discarding any existing cached content." (elpher-cache-content (elpher-page-address elpher-current-page) nil) @@ -627,7 +640,8 @@ the host operating system and the local network capabilities." (unless (< (elpher-address-port address) 65536) (error "Cannot establish network connection: port number > 65536")) (when (and (eq use-tls 'gemini) (not elpher-gemini-TLS-cert-checks)) - (setq-local network-security-level 'low)) + (setq-local network-security-level 'low) + (setq-local gnutls-verify-error nil)) (condition-case nil (let* ((kill-buffer-query-functions nil) (port (elpher-address-port address)) @@ -825,7 +839,7 @@ base for the installed key and certificate files." (mapcar (lambda (file) (file-name-sans-extension file)) - (directory-files elpher-certificate-directory nil "\.key$"))) + (directory-files elpher-certificate-directory nil "\\.key$"))) (defun elpher-forget-current-certificate () "Causes any current certificate to be forgotten.) @@ -1069,7 +1083,7 @@ The response is rendered using the rendering function RENDERER." (elpher-get-gopher-response search-address renderer)) (if aborted (elpher-visit-previous-page)))))) - + ;; Raw server response rendering (defun elpher-render-raw (data &optional mime-type-string) @@ -1375,7 +1389,7 @@ treatment that a separate function is warranted." 'help-echo #'elpher--page-button-help)) (insert (propertize display-string 'face 'elpher-unknown))) (insert "\n")))) - + (defun elpher-gemini-insert-header (header-line) "Insert header described by HEADER-LINE into a text/gemini document. The gemini map file line describing the header is given @@ -1383,14 +1397,15 @@ by HEADER-LINE." (when (string-match "^\\(#+\\)[ \t]*" header-line) (let* ((level (length (match-string 1 header-line))) (header (substring header-line (match-end 0))) - (face (pcase level + (face (pcase level (1 'elpher-gemini-heading1) (2 'elpher-gemini-heading2) (3 'elpher-gemini-heading3) (_ 'default))) - (fill-column (/ (* fill-column - (font-get (font-spec :name (face-font 'default)) :size)) - (font-get (font-spec :name (face-font face)) :size)))) + (fill-column (if (display-graphic-p) + (/ (* fill-column + (font-get (font-spec :name (face-font 'default)) :size)) + (font-get (font-spec :name (face-font face)) :size)) fill-column))) (unless (display-graphic-p) (insert (make-string level ?#) " ")) (insert (propertize header 'face face)) @@ -1401,17 +1416,20 @@ by HEADER-LINE." This function uses Emacs' auto-fill to wrap text sensibly to a maximum width defined by elpher-gemini-max-fill-width." (string-match "\\(^[ \t]*\\)\\(\*[ \t]+\\|>[ \t]*\\)?" text-line) - (let* ((processed-text-line (if (match-string 2 text-line) - (concat - (replace-regexp-in-string "\*" - elpher-gemini-bullet-string - (match-string 0 text-line)) - (substring text-line (match-end 0))) - text-line)) - (adaptive-fill-mode nil) - (fill-prefix (if (match-string 2 text-line) - (replace-regexp-in-string "[>\*]" " " (match-string 0 text-line)) - nil))) + (let* ((line-prefix (match-string 2 text-line)) + (processed-text-line + (if line-prefix + (cond ((string-prefix-p "*" line-prefix) + (concat + (replace-regexp-in-string "\*" + elpher-gemini-bullet-string + (match-string 0 text-line)) + (substring text-line (match-end 0)))) + ((string-prefix-p ">" line-prefix) + (propertize text-line 'face 'elpher-gemini-quoted)) + (t text-line)) + text-line)) + (adaptive-fill-mode nil)) (insert (elpher-process-text-for-display processed-text-line)) (newline))) @@ -1608,7 +1626,7 @@ The result is rendered using RENDERER." 'help-echo help-string)) (insert "\n") (elpher-restore-pos))) - + ;;; Bookmarks ;; @@ -1618,7 +1636,7 @@ The result is rendered using RENDERER." DISPLAY-STRING determines how the bookmark will appear in the bookmark list, while URL is the url of the entry." (list display-string url)) - + (defun elpher-bookmark-display-string (bookmark) "Get the display string of BOOKMARK." (elt bookmark 0)) @@ -1634,6 +1652,9 @@ bookmark list, while URL is the url of the entry." (defun elpher-save-bookmarks (bookmarks) "Record the bookmark list BOOKMARKS to the user's bookmark file. Beware that this completely replaces the existing contents of the file." + (let ((bookmark-dir (file-name-directory elpher-bookmarks-file))) + (unless (file-directory-p bookmark-dir) + (make-directory bookmark-dir))) (with-temp-file elpher-bookmarks-file (erase-buffer) (insert "; Elpher bookmarks file\n\n" @@ -1679,6 +1700,50 @@ If ADDRESS is already bookmarked, update the label only." (not (equal (elpher-bookmark-url bookmark) url))) (elpher-load-bookmarks))))) +;;; Integrations +;; + +(defun elpher-org-link-store () + "Store link to an `elpher' page in org-mode." + (when (eq major-mode 'elpher-mode) + (let ((link (concat "elpher:" (elpher-info-current))) + (desc (car elpher-current-page))) + (org-link-store-props :type "elpher" + :link link + :description desc) + t))) + +(defun elpher-org-link-follow (link _args) + "Follow an `elpher' link in an `org' buffer." + (require 'elpher) + (message (concat "Got link: " link)) + (when (or + (string-match-p "^gemini://.+" link) + (string-match-p "^gopher://.+" link) + (string-match-p "^finger://.+" link)) + (elpher-go (string-remove-prefix "elpher:" link)))) + +(with-eval-after-load "org" + ;; Use `org-link-set-parameters' if defined (org-mode 9+) + (if (fboundp 'org-link-set-parameters) + (org-link-set-parameters "elpher" + :store #'elpher-org-link-store + :follow #'elpher-org-link-follow) + (org-add-link-type "mu4e" 'elpher-org-link-follow) + (add-hook 'org-store-link-functions 'elpher-org-link-store))) + +(defun browse-url-elpher (url &rest _args) + "Browse URL. This function is used by `browse-url'." + (interactive (browse-url-interactive-arg "Elpher URL: ")) + (elpher-go url)) + +(with-eval-after-load "browse-url" + ;; Use elpher to open gopher, finger and gemini links + (add-to-list 'browse-url-default-handlers + '("^\\(gopher\\|finger\\|gemini\\)://" . browse-url-elpher)) + ;; Register "gemini://" as a URI scheme so `browse-url' does the right thing + (add-to-list 'thing-at-point-uri-schemes "gemini://")) + ;;; Interactive procedures ;; @@ -1697,6 +1762,7 @@ If ADDRESS is already bookmarked, update the label only." (interactive) (push-button)) +;;;###autoload (defun elpher-go (host-or-url) "Go to a particular gopher site HOST-OR-URL. When run interactively HOST-OR-URL is read from the minibuffer." @@ -1882,6 +1948,7 @@ When run interactively HOST-OR-URL is read from the minibuffer." (message "Bookmark removed."))) (error "No link selected")))) +;;;###autoload (defun elpher-bookmarks () "Visit bookmarks page." (interactive) @@ -1904,7 +1971,7 @@ When run interactively HOST-OR-URL is read from the minibuffer." (if button (elpher-info-page (button-get button 'elpher-page)) (error "No item selected")))) - + (defun elpher-info-current () "Display information on current page." (interactive)