From: Tim Vaughan <plugd@thelambdalab.xyz>
Date: Mon, 5 Jul 2021 07:23:55 +0000 (+0200)
Subject: Added clickable URLs.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=ea21fb195a01f6078252611b43979f41d3e82b77;p=lurk.git

Added clickable URLs.
---

diff --git a/lurk.el b/lurk.el
index e76c5d1..894f4b1 100644
--- a/lurk.el
+++ b/lurk.el
@@ -35,7 +35,7 @@
 ;;
 
 (defgroup lurk nil
-  "Little Unified iRc Klient."
+  "Little Uni-buffer iRc Klient."
   :group 'network)
 
 (defcustom lurk-nick "plugd"
@@ -93,6 +93,8 @@
 (defvar lurk-prompt-string
   (propertize "> " 'face 'lurk-prompt))
 
+(defvar lurk-debug nil
+  "If non-nil, enable debug mode.")
 
 ;;; Network process
 ;;
@@ -157,6 +159,8 @@
     (and proc (eq (process-status proc) 'open))))
 
 (defun lurk-send-msg (msg)
+  (if lurk-debug
+      (lurk-display-string nil (lurk-msg->string msg)))
   (let ((proc (get-process "lurk")))
     (if (and proc (eq (process-status proc) 'open))
         (process-send-string proc (concat (lurk-msg->string msg) "\r\n"))
@@ -301,7 +305,9 @@ portion of the source component of the message, as LURK doesn't use this.")
 
 (defun lurk-set-current-context (context)
   (setq lurk-current-context context)
-  (lurk-highlight-context context))
+  (lurk-highlight-context context)
+  (if lurk-zoomed
+      (lurk-zoom-in lurk-current-context)))
 
 (defun lurk-cycle-contexts (&optional rev)
   (if lurk-current-context
@@ -363,6 +369,39 @@ portion of the source component of the message, as LURK doesn't use this.")
     (goto-char (point-max))
     (lurk-render-prompt)))
 
+;;; URL buttons
+
+(defconst lurk-url-regex
+  (rx (:
+       (group (+ alpha))
+       "://"
+       (group (or (+ (any alnum "." "-"))
+                  (+ (any alnum ":"))))
+       (opt (group (: ":" (+ digit))))
+       (opt (group (: "/"
+                      (opt
+                       (* (any alnum ",.-~/@|:%#=&_"))
+                       (+ (any alnum "-~/@|:%#=&")))))))))
+
+(defun lurk-click-url (button)
+  (browse-url (button-get button 'url)))
+
+(defun lurk-buttonify-urls (string)
+  "Turn substrings which look like urls in STRING into clickable buttons."
+  (with-temp-buffer
+    (insert string)
+    (goto-char (point-min))
+    (while (re-search-forward lurk-url-regex nil t)
+      (let ((url (match-string 0)))
+        (make-text-button (match-beginning 0)
+                          (match-end 0)
+                          'action #'lurk-click-url
+                          'url url
+                          'follow-link t
+                          'face 'button
+                          'help-echo "Open URL in browser.")))
+    (buffer-string)))
+
 
 ;;; Output formatting and highlighting
 ;;
@@ -405,14 +444,12 @@ portion of the source component of the message, as LURK doesn't use this.")
                      'face (lurk-get-context-facelist context)
                      'read-only t
                      'context context
-                     'invisible context-atom
-                     'help-echo (concat "Context: " (or context "none")))
-         (propertize (concat (apply #'concat strings) "\n")
+                     'invisible context-atom)
+         (propertize (concat (lurk-buttonify-urls (apply #'concat strings)) "\n")
                      'face (lurk-get-context-facelist context)
                      'read-only t
                      'context context
-                     'invisible context-atom
-                     'help-echo (concat "Context: " (or context "none"))))
+                     'invisible context-atom))
         (fill-region old-pos lurk-prompt-marker nil t)))))
 
 (defun lurk-display-message (from to text)
@@ -483,7 +520,8 @@ portion of the source component of the message, as LURK doesn't use this.")
 ;;
 
 (defun lurk-eval-msg-string (string)
-  ;; (lurk-display-string nil string)
+  (if lurk-debug
+      (lurk-display-string nil string))
   (let* ((msg (lurk-string->msg string)))
     (pcase (lurk-msg-cmd msg)
       ("PING"
@@ -528,6 +566,8 @@ portion of the source component of the message, as LURK doesn't use this.")
               (topic (elt params 2)))
          (lurk-display-notice channel "Topic: " topic)))
 
+      ("333") ; Avoid displaying these
+
       ((rx (= 3 (any digit)))
        (lurk-display-notice nil (mapconcat 'identity (cdr (lurk-msg-params msg)) " ")))
 
@@ -617,10 +657,6 @@ portion of the source component of the message, as LURK doesn't use this.")
             (lurk-display-action from to action-text))
 
            (_
-            (if (and (equal from "BitBot")
-                     (equal to "##moshpit")
-                     (cl-search "\\_o< QUACK!" text))
-              (lurk-send-msg (lurk-msg nil nil "PRIVMSG" to ",bef")))
             (lurk-display-message from to text)))))
       (_
        (lurk-display-notice nil (lurk-msg->string msg))))))
@@ -632,6 +668,10 @@ portion of the source component of the message, as LURK doesn't use this.")
 (defun lurk-enter-string (string)
   (if (string-prefix-p "/" string)
       (pcase (substring string 1)
+        ((rx "DEBUG")
+         (setq lurk-debug (not lurk-debug))
+         (lurk-display-notice nil "Debug mode now " (if lurk-debug "on" "off") "."))
+
         ((rx (: "CONNECT " (let network (* not-newline))))
          (lurk-display-notice nil "Attempting to connect to " network "...")
          (lurk-connect network))
@@ -670,6 +710,12 @@ portion of the source component of the message, as LURK doesn't use this.")
            (setq lurk-nick nick)
            (lurk-display-notice nil "Set default nick to '" nick "'")))
 
+        ((rx "LIST")
+         (lurk-display-notice nil "This command can generate lots of output. Use `LIST -yes' if you're sure."))
+
+        ((rx (: "LIST" (+ whitespace) "-YES"))
+         (lurk-send-msg (lurk-msg nil nil "LIST")))
+
         ((rx "MSG "
              (let to (* (not whitespace)))
              " "
@@ -753,9 +799,9 @@ portion of the source component of the message, as LURK doesn't use this.")
   (interactive)
   (if (get-buffer "*lurk*")
       (switch-to-buffer "*lurk*")
-    (switch-to-buffer "*lurk*"))
-  (lurk-mode)
-  (lurk-setup-buffer)
+    (switch-to-buffer "*lurk*")
+    (lurk-mode)
+    (lurk-setup-buffer))
   "Started LURK.")