master 5699e43f27 06/10: Accommodate ircs:// URLs in url-irc and browse-url

[F. Jason Park]

branch: master
commit 5699e43f27ef5ca760a38572928be8a53819a430
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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 1e7190e830..bb2bd52134 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -439,6 +439,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
@@ -2642,6 +2648,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
@@ -2868,6 +2885,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 @@ be used instead."
           (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 @@ process), or nil (we don't know)."
 (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 @@ process), or nil (we don't know)."
 (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 @@ used instead of `browse-url-new-window-flag'."
 
 (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 @@ The function should take the following arguments:
     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 @@ PASSWORD - What password to use"
 (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 @@ PASSWORD - What password to use"
       (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 @@ PASSWORD - What password to use"
         (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--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))