;;; elpher.el --- A friendly gopher and gemini client -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Tim Vaughan
+;; Copyright (C) 2021 Jens Östlund <jostlund@gmail.com>
+;; Copyright (C) 2021 F. Jason Park <jp@neverwas.me>
+;; Copyright (C) 2021 Christopher Brannon <chris@the-brannons.com>
+;; Copyright (C) 2021 Omar Polo <op@omarpolo.com>
+;; Copyright (C) 2021 Noodles! <nnoodle@chiru.no>
+;; Copyright (C) 2020-2021 Alex Schroeder <alex@gnu.org>
+;; Copyright (C) 2020 Étienne Deparis <etienne@depar.is>
+;; Copyright (C) 2020 Simon Nicolussi <sinic@sinic.name>
+;; Copyright (C) 2020 Michel Alexandre Salim <michel@michel-slm.name>
+;; Copyright (C) 2020 Koushk Roy <kroy@twilio.com>
+;; Copyright (C) 2020 Vee <vee@vnsf.xyz>
+;; Copyright (C) 2020 Simon South <simon@simonsouth.net>
+;; Copyright (C) 2019-2020 Tim Vaughan <plugd@thelambdalab.xyz>
;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 2.10.2
+;; Version: 2.11.0
;; Keywords: comm gopher
;; Homepage: http://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "26.2"))
(require 'url-util)
(require 'subr-x)
(require 'dns)
-(require 'ansi-color)
(require 'nsm)
(require 'gnutls)
(require 'socks)
+;;; ANSI colors or XTerm colors
+
+(or (require 'xterm-color nil t)
+ (require 'ansi-color))
+
+(defalias 'elpher-color-filter-apply
+ (if (fboundp 'xterm-color-filter)
+ (lambda (s)
+ (let ((xterm-color-render nil))
+ (xterm-color-filter s)))
+ 'ansi-color-filter-apply)
+ "A function to filter out ANSI escape sequences.")
+(defalias 'elpher-color-apply
+ (if (fboundp 'xterm-color-filter)
+ 'xterm-color-filter
+ 'ansi-color-apply)
+ "A function to apply ANSI escape sequences.")
;;; Global constants
;;
"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.
'((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
;;
(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")))
(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)
(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))
(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.)
(if type-map-entry
(let* ((margin-code (elt type-map-entry 2))
(face (elt type-map-entry 3))
- (filtered-display-string (ansi-color-filter-apply display-string))
+ (filtered-display-string (elpher-color-filter-apply display-string))
(page (elpher-make-page filtered-display-string address)))
(elpher-insert-margin margin-code)
(insert-text-button filtered-display-string
"Perform any desired processing of STRING prior to display as text.
Currently includes buttonifying URLs and processing ANSI escape codes."
(elpher-buttonify-urls (if elpher-filter-ansi-from-text
- (ansi-color-filter-apply string)
- (ansi-color-apply string))))
+ (elpher-color-filter-apply string)
+ (elpher-color-apply string))))
(defun elpher-render-text (data &optional _mime-type-string)
"Render DATA as text. MIME-TYPE-STRING is unused."
(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)
(insert elpher-gemini-link-string)
(if type-map-entry
(let* ((face (elt type-map-entry 3))
- (filtered-display-string (ansi-color-filter-apply display-string))
+ (filtered-display-string (elpher-color-filter-apply display-string))
(page (elpher-make-page filtered-display-string address)))
(insert-text-button filtered-display-string
'face face
'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
(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))
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)))
'help-echo help-string))
(insert "\n")
(elpher-restore-pos)))
-
+
;;; Bookmarks
;;
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))
(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"
(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
+ (when (boundp 'browse-url-default-handlers)
+ (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
;;
(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."
(message "Bookmark removed.")))
(error "No link selected"))))
+;;;###autoload
(defun elpher-bookmarks ()
"Visit bookmarks page."
(interactive)
(if button
(elpher-info-page (button-get button 'elpher-page))
(error "No item selected"))))
-
+
(defun elpher-info-current ()
"Display information on current page."
(interactive)
The Lambda Lab / projects / elpher.git / blobdiff