From ea21fb195a01f6078252611b43979f41d3e82b77 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Mon, 5 Jul 2021 09:23:55 +0200 Subject: [PATCH] Added clickable URLs. --- lurk.el | 76 +++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 61 insertions(+), 15 deletions(-) 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.") -- 2.20.1