From 41d7f52984e6220123b8ccc7da1b1d56a9a7eb49 Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Sun, 28 Oct 2018 03:11:21 +0000 Subject: [PATCH] Add URL truncation support to rcirc (bug#33043) Suggested by David Edmondson . * lisp/net/rcirc.el (rcirc-url-max-length): New user option controlling extent of URL truncation, defaulting to none. (rcirc-markup-urls): Use it. * etc/NEWS: Announce it. --- etc/NEWS | 7 +++++++ lisp/net/rcirc.el | 26 ++++++++++++++++++-------- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 226ae1e135..f7fdd0add9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -758,6 +758,13 @@ Tramp for some look-alike remote file names. *** For some connection methods, like "su" or "sudo", the host name in ad-hoc multi-hop file names must match the previous hop. +** Rcirc + +--- +*** New user option 'rcirc-url-max-length'. +Setting this option to an integer causes URLs displayed in Rcirc +buffers to be truncated to that many characters. + ** Register --- *** The return value of method 'register-val-describe' includes the diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index fe9c71a21c..ca707341be 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -168,6 +168,14 @@ rcirc-fill-prefix (string :tag "Prefix text")) :group 'rcirc) +(defcustom rcirc-url-max-length nil + "Maximum number of characters in displayed URLs. +If nil, no maximum is applied." + :version "27.1" + :type '(choice (const :tag "No maximum" nil) + (integer :tag "Number of characters")) + :group 'rcirc) + (defvar rcirc-ignore-buffer-activity-flag nil "If non-nil, ignore activity in this buffer.") (make-variable-buffer-local 'rcirc-ignore-buffer-activity-flag) @@ -2485,24 +2493,26 @@ rcirc-markup-my-nick (rcirc-record-activity (current-buffer) 'nick))))) (defun rcirc-markup-urls (_sender _response) - (while (and rcirc-url-regexp ;; nil means disable URL catching + (while (and rcirc-url-regexp ; nil means disable URL catching. (re-search-forward rcirc-url-regexp nil t)) (let* ((start (match-beginning 0)) - (end (match-end 0)) - (url (match-string-no-properties 0)) - (link-text (buffer-substring-no-properties start end))) + (url (buffer-substring-no-properties start (point)))) + (when rcirc-url-max-length + ;; Replace match with truncated URL. + (delete-region start (point)) + (insert (url-truncate-url-for-viewing url rcirc-url-max-length))) ;; Add a button for the URL. Note that we use `make-text-button', ;; rather than `make-button', as text-buttons are much faster in ;; large buffers. - (make-text-button start end + (make-text-button start (point) 'face 'rcirc-url 'follow-link t 'rcirc-url url 'action (lambda (button) (browse-url (button-get button 'rcirc-url)))) - ;; record the url if it is not already the latest stored url - (when (not (string= link-text (caar rcirc-urls))) - (push (cons link-text start) rcirc-urls))))) + ;; Record the URL if it is not already the latest stored URL. + (unless (string= url (caar rcirc-urls)) + (push (cons url start) rcirc-urls))))) (defun rcirc-markup-keywords (sender response) (when (and (string= response "PRIVMSG") -- 2.19.1