From 929465942c10a1434ac6333ba6f3df9a110b0199 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 2/6] Accommodate ircs:// URLs in url-irc and browse-url * lisp/url/url-irc.el (url-irc-function): Change signature of function interface to expect a final "scheme" argument, such as "ircs". (url-irc): Call `url-irc-function' with new positional argument, the scheme extracted via `url-type' from the input URL. (url-irc-erc, url-irc-rcirc, url-irc-zenirc): Accept a URL scheme as a sixth positional arg. (url-ircs-default-port, url-ircs): Add new autoloaded constant and alias for `url-scheme-get-property' to recognize. Do this to avoid having to add another file. * lisp/net/browse-url.el (browse-url-irc-function): Add new option. (browse-url--irc): Add new function to call `browse-url-irc-function'. (browse-url-default-handlers): Add "irc://" entry. (browse-url-irc): Add new function to serve as general handler for "irc://" URLS. Accept trailing variadic args to accommodate non-browse-url interfaces as well. * test/lisp/net/browse-url-tests.el (browse-url-tests-select-handler-irc): Add test for "irc://" URL pattern. * etc/NEWS: Mention select browse-url and url-irc changes. Bug#56514. --- etc/NEWS | 20 +++++++++++++++++++ lisp/net/browse-url.el | 24 +++++++++++++++++++++++ lisp/url/url-irc.el | 32 ++++++++++++++++++++++++------- test/lisp/net/browse-url-tests.el | 9 +++++++++ 4 files changed, 78 insertions(+), 7 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ab64eff74e..500ac5e50b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -438,6 +438,12 @@ The user options 'url-gateway-rlogin-host', 'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name' are also obsolete. +--- +** The user function 'url-irc-function' now takes a 'scheme' argument. +The user option 'url-irc-function' is now called with a sixth argument +corresponding to the scheme portion of the target URL. For example, +this would be "ircs" for a URL like "ircs://irc.libera.chat". + --- ** The linum.el library is now obsolete. We recommend using either the built-in 'display-line-numbers-mode', or @@ -2616,6 +2622,17 @@ This user option decides which URL scheme that 'browse-url' and related functions will use by default. For example, you could customize this to "https" to always prefer HTTPS URLs. +--- +*** New user option 'browse-url-irc-function'. +This option specifies a function for opening irc:// links. It +defaults to the new function 'browse-url-irc'. + +--- +*** New function 'browse-url-irc'. +This multipurpose autoloaded function can be used for opening irc:// +and ircs:// URLS by any caller that passes a URL string as an initial +arg. + --- *** Support for the Netscape web browser has been removed. This support has been obsolete since Emacs 25.1. The final version of @@ -2842,6 +2859,9 @@ remote host are shown. Alternatively, the user option *** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'. The old name is still available as an obsolete function alias. +--- +*** The url-irc library now understands ircs:// links. + --- *** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'. It copies the current line into the kill ring. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 1597f3651a..7ac6396d31 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -222,6 +222,14 @@ browse-url-man-function (function :tag "Other function")) :version "26.1") +(defcustom browse-url-irc-function 'browse-url-irc + "Function to open an irc:// link." + :type '(choice + (function-item :tag "Emacs IRC" :value browse-url-irc) + (const :tag "None" nil) + (function :tag "Other function")) + :version "29.1") + (defcustom browse-url-button-regexp (concat "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|" @@ -547,6 +555,11 @@ browse-url--browser-kind-man (function-put 'browse-url--man 'browse-url-browser-kind #'browse-url--browser-kind-man) +(defun browse-url--irc (url &rest args) + "Call `browse-url-irc-function' with URL and ARGS." + (funcall browse-url-irc-function url args)) +(function-put 'browse-url--irc 'browse-url-browser-kind 'internal) + (defun browse-url--browser (url &rest args) "Call `browse-url-browser-function' with URL and ARGS." (funcall browse-url-browser-function url args)) @@ -565,6 +578,7 @@ browse-url--non-html-file-url-p (defvar browse-url-default-handlers '(("\\`mailto:" . browse-url--mailto) ("\\`man:" . browse-url--man) + ("\\`irc6?s?://" . browse-url--irc) (browse-url--non-html-file-url-p . browse-url-emacs)) "Like `browse-url-handlers' but populated by Emacs and packages. @@ -1510,6 +1524,16 @@ browse-url-text-emacs (function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal) +;; --- irc --- + +;;;###autoload +(defun browse-url-irc (url &rest _) + "Call `url-irc' directly after parsing URL. +This function is a fit for options like `gnus-button-alist'." + (url-irc (url-generic-parse-url url))) + +(function-put 'browse-url-irc 'browse-url-browser-kind 'internal) + ;; --- mailto --- (autoload 'rfc6068-parse-mailto-url "rfc6068") diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 9161f7d13e..f97b6de6fe 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -38,11 +38,13 @@ url-irc-function PORT - the port number of the IRC server to contact CHANNEL - What channel on the server to visit right away (can be nil) USER - What username to use -PASSWORD - What password to use" +PASSWORD - What password to use. + SCHEME - a URI scheme, such as \"irc\" or \"ircs\"" :type '(choice (const :tag "rcirc" :value url-irc-rcirc) (const :tag "ERC" :value url-irc-erc) (const :tag "ZEN IRC" :value url-irc-zenirc) (function :tag "Other")) + :version "29.1" ; Added SCHEME :group 'url) ;; External. @@ -51,7 +53,7 @@ url-irc-function (defvar zenirc-server-alist) (defvar zenirc-buffer-name) -(defun url-irc-zenirc (host port channel user password) +(defun url-irc-zenirc (host port channel user password _) (let ((zenirc-buffer-name (if (and user host port) (format "%s@%s:%d" user host port) (format "%s:%d" host port))) @@ -65,14 +67,14 @@ url-irc-zenirc (insert "/join " channel) (zenirc-send-line)))) -(defun url-irc-rcirc (host port channel user password) +(defun url-irc-rcirc (host port channel user password _) (let ((chan (when channel (concat "#" channel)))) (rcirc-connect host port user nil nil (when chan (list chan)) password) (when chan (switch-to-buffer (concat chan "@" host))))) -(defun url-irc-erc (host port channel user password) - (erc-handle-irc-url host port channel user password)) +(defun url-irc-erc (host port channel user password scheme) + (erc-handle-irc-url host port channel user password scheme)) ;;;###autoload (defun url-irc (url) @@ -80,16 +82,32 @@ url-irc (port (url-port url)) (pass (url-password url)) (user (url-user url)) - (chan (url-filename url))) + (chan (url-filename url)) + (type (url-type url)) + (compatp (eql 5 (cdr (func-arity url-irc-function))))) (if (url-target url) (setq chan (concat chan "#" (url-target url)))) (if (string-match "^/" chan) (setq chan (substring chan 1 nil))) (if (= (length chan) 0) (setq chan nil)) - (funcall url-irc-function host port chan user pass) + (when compatp + (lwarn 'url :error "Obsolete value for `url-irc-function'")) + (apply url-irc-function + host port chan user pass (unless compatp (list type))) nil)) +;;;; ircs:// + +;; The function `url-scheme-get-property' tries and fails to load the +;; nonexistent url-ircs.el but falls back to using the following: + +;;;###autoload +(defconst url-ircs-default-port 6697 "Default port for IRCS connections.") + +;;;###autoload +(defalias 'url-ircs 'url-irc) + (provide 'url-irc) ;;; url-irc.el ends here diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el index 1c993958b8..dc81976821 100644 --- a/test/lisp/net/browse-url-tests.el +++ b/test/lisp/net/browse-url-tests.el @@ -56,6 +56,15 @@ browse-url-tests-select-handler-man 'browse-url--man)) (should-not (browse-url-select-handler "man:ls" 'external))) +(ert-deftest browse-url-tests-select-handler-irc () + (should (eq (browse-url-select-handler "irc://localhost" 'internal) + 'browse-url--irc)) + (should-not (browse-url-select-handler "irc://localhost" 'external)) + (should (eq (browse-url-select-handler "irc6://localhost") + 'browse-url--irc)) + (should (eq (browse-url-select-handler "ircs://tester@irc.gnu.org/#chan") + 'browse-url--irc))) + (ert-deftest browse-url-tests-select-handler-file () (should (eq (browse-url-select-handler "file://foo.txt") 'browse-url-emacs)) -- 2.38.1