diff options
Diffstat (limited to 'lisp/erc/erc-speedbar.el')
| -rw-r--r-- | lisp/erc/erc-speedbar.el | 406 |
1 files changed, 359 insertions, 47 deletions
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index accfb8ac703..a81a3869436 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -32,19 +32,31 @@ ;; update-channel, update-nick, remove-nick-from-channel, ... ;; * Use indicator-strings for op/voice ;; * Extract/convert face notes field from bbdb if available +;; * Write tests that run in a term-mode subprocess ;; ;;; Code: (require 'erc) +(require 'erc-goodies) +(require 'erc-button) (require 'speedbar) -(condition-case nil (require 'dframe) (error nil)) ;;; Customization: (defgroup erc-speedbar nil - "Integration of ERC in the Speedbar." + "Speedbar integration for ERC. +To open an ERC-flavored speedbar in a separate frame, run the +command `erc-speedbar-browser'. To use a window-based proxy +instead, run \\[erc-nickbar-mode] in a connected ERC buffer or +put `nickbar' in `erc-modules' before connecting. See Info +node `(speedbar) Top' for more about the underlying integration." :group 'erc) +(defcustom erc-speedbar-nicknames-window-width 18 + "Default width of the nicknames sidebar (in columns)." + :package-version '(ERC . "5.6") + :type 'integer) + (defcustom erc-speedbar-sort-users-type 'activity "How channel nicknames are sorted. @@ -55,6 +67,23 @@ nil - Do not sort users" (const :tag "Sort users alphabetically" alphabetical) (const :tag "Do not sort users" nil))) +(defcustom erc-speedbar-hide-mode-topic 'headerline + "Hide mode and topic lines." + :package-version '(ERC . "5.6") + :type '(choice (const :tag "Always show" nil) + (const :tag "Always hide" t) + (const :tag "Omit when headerline visible" headerline))) + +(defcustom erc-speedbar-my-nick-face t + "A face to use for your nickname. +When the value is t, ERC uses `erc-current-nick-face' if +`erc-match' has been loaded and `erc-my-nick-face' otherwise. +When using the `nicks' module, you can see your nick as it +appears to others by coordinating with the option +`erc-nicks-skip-faces'." + :package-version '(ERC . "5.6") + :type '(choice face (const :tag "Current nick or own speaker face" t))) + (defvar erc-speedbar-key-map nil "Keymap used when in erc display mode.") @@ -87,10 +116,6 @@ nil - Do not sort users" (looking-at "[0-9]+: *.-. "))]) "Additional menu-items to add to speedbar frame.") -;; Make sure our special speedbar major mode is loaded -(with-eval-after-load 'speedbar - (erc-install-speedbar-variables)) - ;;; ERC hierarchy display method ;;;###autoload (defun erc-speedbar-browser () @@ -98,6 +123,7 @@ nil - Do not sort users" This will add a speedbar major display mode." (interactive) (require 'speedbar) + (erc-install-speedbar-variables) ;; Make sure that speedbar is active (speedbar-frame-mode 1) ;; Now, throw us into Info mode on speedbar. @@ -109,7 +135,15 @@ This will add a speedbar major display mode." (erase-buffer) (let (serverp chanp queryp) (with-current-buffer buffer - (setq serverp (erc-server-buffer-p)) + ;; The function `dframe-help-echo' checks the default value of + ;; `dframe-help-echo-function' when deciding whether to visit + ;; the buffer and fire the callback. This works in normal + ;; speedbar frames because the event handler runs in the + ;; `window-buffer' of the active frame. But in our hacked + ;; version, where the frame is hidden, `speedbar-item-info' + ;; never runs without this workaround. + (setq-local dframe-help-echo-function #'ignore) + (setq serverp (erc--server-buffer-p)) (setq chanp (erc-channel-p (erc-default-target))) (setq queryp (erc-query-buffer-p))) (cond (serverp @@ -168,18 +202,29 @@ This will add a speedbar major display mode." t))))) (defun erc-speedbar-insert-target (buffer depth) - (if (with-current-buffer buffer - (erc-channel-p (erc-default-target))) - (speedbar-make-tag-line - 'bracket ?+ 'erc-speedbar-expand-channel buffer - (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil - depth) + (if (erc--target-channel-p (buffer-local-value 'erc--target buffer)) + (progn + (speedbar-make-tag-line + 'bracket ?+ 'erc-speedbar-expand-channel buffer + (erc--target-string (buffer-local-value 'erc--target buffer)) + 'erc-speedbar-goto-buffer buffer nil + depth) + (save-excursion + (forward-line -1) + (let ((table (buffer-local-value 'erc-channel-users buffer))) + (speedbar-add-indicator (format "(%d)" (hash-table-count table))) + (rx "(" (+ (any "0-9")) ")")))) ;; Query target (speedbar-make-tag-line nil nil nil nil (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil depth))) +(defconst erc-speedbar--fmt-sentinel (gensym "erc-speedbar-") + "Symbol for identifying a nonstandard `speedbar-token' text property. +When encountered, ERC assumes the value's tail contains +`format'-compatible args.") + (defun erc-speedbar-expand-channel (text channel indent) "For the line matching TEXT, in CHANNEL, expand or contract a line. INDENT is the current indentation level." @@ -189,36 +234,25 @@ INDENT is the current indentation level." (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) - (let ((modes (with-current-buffer channel - (concat (apply #'concat - erc-channel-modes) - (cond - ((and erc-channel-user-limit - erc-channel-key) - (if erc-show-channel-key-p - (format "lk %.0f %s" - erc-channel-user-limit - erc-channel-key) - (format "kl %.0f" erc-channel-user-limit))) - (erc-channel-user-limit - ;; Emacs has no bignums - (format "l %.0f" erc-channel-user-limit)) - (erc-channel-key - (if erc-show-channel-key-p - (format "k %s" erc-channel-key) - "k")) - (t ""))))) + (let ((modes (buffer-local-value 'erc--mode-line-mode-string channel)) (topic (erc-controls-interpret (with-current-buffer channel erc-channel-topic)))) - (speedbar-make-tag-line - 'angle ?i nil nil - (concat "Modes: +" modes) nil nil nil - (1+ indent)) + (when modes + (speedbar-make-tag-line + 'angle ?m nil (list erc-speedbar--fmt-sentinel "Mode: %s" modes) + modes nil nil 'erc-notice-face (1+ indent))) (unless (string= topic "") (speedbar-make-tag-line - 'angle ?i nil nil - (concat "Topic: " topic) nil nil nil + 'angle ?t nil (list erc-speedbar--fmt-sentinel "Topic: %s" topic) + topic nil nil 'erc-notice-face (1+ indent))) + (unless (pcase erc-speedbar-hide-mode-topic + ('nil 'show) + ('headerline (null erc-header-line-format))) + (save-excursion + (goto-char (point-max)) + (forward-line (if (string= topic "") -1 -2)) + (put-text-property (pos-bol) (point-max) 'invisible t))) (let ((names (cond ((eq erc-speedbar-sort-users-type 'alphabetical) (erc-sort-channel-users-alphabetically (with-current-buffer channel @@ -232,17 +266,52 @@ INDENT is the current indentation level." (when names (speedbar-with-writable (dolist (entry names) - (erc-speedbar-insert-user entry ?+ (1+ indent)))))))))) + (erc-speedbar-insert-user entry ?+ (1+ indent) channel))))))))) ((string-search "-" text) (speedbar-change-expand-button-char ?+) (speedbar-delete-subblock indent)) (t (error "Ooops... not sure what to do"))) (speedbar-center-buffer-smartly)) -(defun erc-speedbar-insert-user (entry exp-char indent) +(defvar erc-speedbar--nick-face-function #'erc-speedbar--highlight-self-and-ops + "Function called when finding a face for fontifying nicks. +Called with the proposed nick, the `erc-server-user', and the +`erc-channel-user'. Should return any valid face, possibly +composed or anonymous, or nil.") + +(defun erc-speedbar--highlight-self-and-ops (buffer user cuser) + "Highlight own nick and op'd users in the speedbar." + (with-current-buffer buffer + (if (erc-current-nick-p (erc-server-user-nickname user)) + (pcase erc-speedbar-my-nick-face + ('t (if (facep 'erc-current-nick-face) + 'erc-current-nick-face + 'erc-my-nick-face)) + (v v)) + ;; FIXME overload `erc-channel-user-owner-p' and friends to + ;; accept an `erc-channel-user' object and replace this unrolled + ;; stuff with a single call to `erc-get-user-mode-prefix'. + (and cuser (or (erc-channel-user-owner cuser) + (erc-channel-user-admin cuser) + (erc-channel-user-op cuser) + (erc-channel-user-halfop cuser) + (erc-channel-user-voice cuser)) + erc-button-nickname-face)))) + +(defun erc-speedbar--on-click (nick sbtoken _indent) + ;; 0: finger, 1: name, 2: info, 3: buffer-name + (with-current-buffer (nth 3 sbtoken) + (erc-nick-popup (string-trim-left nick "[~&@%+]+")))) + +(defun erc-speedbar-insert-user (entry exp-char indent &optional buffer) "Insert one user based on the channel member list ENTRY. -EXP-CHAR is the expansion character to use. -INDENT is the current indentation level." +Expect EXP-CHAR to be the expansion character to use, INDENT the +current indentation level, and BUFFER the associated channel or +query buffer. Set the `speedbar-function' text property to +`erc-speedbar--on-click', which is called with the formatted +nick, a so-called \"token\", and the indent level. The token is +a list of four items: the userhost, the GECOS, the current +`erc-server-user' info slot, and the associated buffer." (let* ((user (car entry)) (cuser (cdr entry)) (nick (erc-server-user-nickname user)) @@ -250,15 +319,16 @@ INDENT is the current indentation level." (info (erc-server-user-info user)) (login (erc-server-user-login user)) (name (erc-server-user-full-name user)) - (voice (and cuser (erc-channel-user-voice cuser))) - (op (and cuser (erc-channel-user-op cuser))) - (nick-str (concat (if op "@" "") (if voice "+" "") nick)) + (nick-str (concat (with-current-buffer (or buffer (current-buffer)) + (erc-get-channel-membership-prefix cuser)) + nick)) (finger (concat login (when (or login host) "@") host)) - (sbtoken (list finger name info))) + (sbtoken (list finger name info (buffer-name buffer)))) (if (or login host name info) ; we want to be expandable (speedbar-make-tag-line 'bracket ?+ 'erc-speedbar-expand-user sbtoken - nick-str nil sbtoken nil + nick-str #'erc-speedbar--on-click sbtoken + (funcall erc-speedbar--nick-face-function buffer user cuser) indent) (when (equal exp-char ?-) (forward-line -1) @@ -353,9 +423,251 @@ The INDENT level is ignored." (message "%s: %s" txt (car data))) ((bufferp data) (message "Channel: %s" txt)) + ;; Print help if line has a non-standard ([-+?=]) button + ;; char and a `speedbar-token' property with a known CAR. + ((and-let* ((p (text-property-not-all (pos-bol) (pos-eol) + 'speedbar-token nil)) + (v (get-text-property p 'speedbar-token)) + ((eq erc-speedbar--fmt-sentinel (car v)))) + (apply #'message (cdr v)))) (t (message "%s" txt))))) + +;;;; Status-sidebar integration + +(defvar erc-track-mode) +(defvar erc-track--switch-fallback-blockers) +(defvar erc-status-sidebar-buffer-name) +(declare-function erc-status-sidebar-set-window-preserve-size + "erc-status-sidebar" nil) + +(defvar erc-speedbar--buffer-options + '((speedbar-update-flag . t) + (speedbar-use-images . nil) + (speedbar-hide-button-brackets-flag . t))) + +(defvar erc-speedbar--hidden-speedbar-frame nil) + +(defun erc-speedbar--emulate-sidebar-set-window-preserve-size () + (let ((erc-status-sidebar-buffer-name (buffer-name speedbar-buffer)) + (display-buffer-overriding-action + `(display-buffer-in-side-window + . ((side . right) + (window-width . ,erc-speedbar-nicknames-window-width))))) + (erc-status-sidebar-set-window-preserve-size))) + +(defun erc-speedbar--status-sidebar-mode--unhook () + "Remove hooks installed by `erc-status-sidebar-mode'." + (remove-hook 'window-configuration-change-hook + #'erc-speedbar--emulate-sidebar-set-window-preserve-size)) + +(defun erc-speedbar--emulate-sidebar () + (require 'erc-status-sidebar) + (cl-assert speedbar-frame) + (cl-assert (eq speedbar-buffer (current-buffer))) + (cl-assert (eq speedbar-frame (selected-frame))) + (setq erc-speedbar--hidden-speedbar-frame speedbar-frame + ;; In Emacs 27, this is not `local-variable-if-set-p'. + dframe-controlled #'erc-speedbar--dframe-controlled) + (add-hook 'window-configuration-change-hook + #'erc-speedbar--emulate-sidebar-set-window-preserve-size nil t) + (add-hook 'kill-buffer-hook + #'erc-speedbar--status-sidebar-mode--unhook nil t) + (with-current-buffer speedbar-buffer + (pcase-dolist (`(,var . ,val) erc-speedbar--buffer-options) + (set (make-local-variable var) val))) + (when (memq 'nicks erc-modules) + (with-current-buffer speedbar-buffer + (add-function :around (local 'erc-speedbar--nick-face-function) + #'erc-speedbar--compose-nicks-face)))) + +(defun erc-speedbar--toggle-nicknames-sidebar (arg) + (let ((force (numberp arg))) + (if speedbar-buffer + (progn + (cl-assert (buffer-live-p speedbar-buffer)) + (if (or (and force (< arg 0)) + (and (not force) (get-buffer-window speedbar-buffer nil))) + ;; Close associated windows and stop updating but leave timer. + (progn + (dolist (window (get-buffer-window-list speedbar-buffer nil t)) + (unless (frame-root-window-p window) + (when erc-speedbar--hidden-speedbar-frame + (cl-assert + (not (eq (window-frame window) + erc-speedbar--hidden-speedbar-frame)))) + (delete-window window))) + (with-current-buffer speedbar-buffer + (setq speedbar-update-flag nil) + (speedbar-set-mode-line-format))) + (when (or (not force) (>= arg 0)) + (with-selected-frame speedbar-frame + (erc-speedbar--emulate-sidebar-set-window-preserve-size) + (erc-speedbar-toggle-nicknames-window-lock -1))))) + (when-let (((or (not force) (>= arg 0))) + (speedbar-frame-parameters (backquote-list* + '(visibility . nil) + '(no-other-frame . t) + speedbar-frame-parameters)) + (speedbar-after-create-hook #'erc-speedbar--emulate-sidebar)) + (erc-install-speedbar-variables) + ;; Run before toggling mode to prevent timer from being + ;; created twice. + (speedbar-change-initial-expansion-list "ERC") + (speedbar-frame-mode 1) + ;; If we put the remaining parts in the "create hook" along + ;; with everything else, the frame with `window-main-window' + ;; gets raised and steals focus if you've switched away from + ;; Emacs in the meantime. + (make-frame-invisible speedbar-frame) + (select-frame (setq speedbar-frame (previous-frame))) + (erc-speedbar--emulate-sidebar-set-window-preserve-size) + (erc-speedbar-toggle-nicknames-window-lock -1)))) + (cl-assert (not (cdr (erc-speedbar--get-timers))) t)) + +(defun erc-speedbar--ensure (&optional force) + (when (or (erc-server-buffer) force) + (when erc-track-mode + (cl-pushnew '(derived-mode . speedbar-mode) + erc-track--switch-fallback-blockers :test #'equal)) + (unless speedbar-update-flag + (erc-button--display-error-notice-with-keys + (erc-server-buffer) + "Module `nickbar' needs `speedbar-update-flag' to be non-nil" + (and (not (display-graphic-p)) " in text terminals") + ". Setting to t for the current Emacs session." + " Customize it permanently to avoid this message.") + (setq speedbar-update-flag t)) + (erc-speedbar--toggle-nicknames-sidebar +1) + (with-current-buffer speedbar-buffer + (setq speedbar-update-flag t) + (speedbar-set-mode-line-format)))) + +(defvar erc-speedbar--shutting-down-p nil) +(defvar erc-speedbar--force-update-interval-secs 5 "Speedbar update period.") + +(defvar-local erc-speedbar--last-ran nil + "When non-nil, a lisp timestamp updated when the speedbar timer runs.") + +(defun erc-speedbar--run-timer-on-post-insert () + "Refresh speedbar if idle for `erc-speedbar--force-update-interval-secs'." + (when speedbar-buffer + (with-current-buffer speedbar-buffer + (when-let + ((dframe-timer) + ((erc--check-msg-prop 'erc--cmd 'PRIVMSG)) + (interval erc-speedbar--force-update-interval-secs) + ((or (null erc-speedbar--last-ran) + (time-less-p erc-speedbar--last-ran + (time-subtract (current-time) interval))))) + (run-at-time 0 nil #'dframe-timer-fn))))) + +(defun erc-speedbar--reset-last-ran-on-timer () + "Reset `erc-speedbar--last-ran'." + (when speedbar-buffer + (with-suppressed-warnings ((obsolete buffer-local-value)) ; <=29 + (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) + (current-time))))) + +;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t) +(define-erc-module nickbar nil + "Show nicknames for current target buffer in a side window. +When enabling, create a speedbar session if one doesn't exist and +show its buffer in an `erc-status-sidebar' window instead of a +separate frame. When disabling, close the window or, with a +negative prefix arg, destroy the session. + +WARNING: this module may produce unwanted side effects, like the +raising of frames or the stealing of input focus. If you witness +such a thing and can reproduce it, please file a bug report with +\\[erc-bug]." + ((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) + (add-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) + (add-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) + (erc-speedbar--ensure) + (unless (or erc--updating-modules-p + (and-let* ((speedbar-buffer) + (win (get-buffer-window speedbar-buffer 'all-frames)) + ((eq speedbar-frame (window-frame win)))))) + (when-let ((buf (or (and (derived-mode-p 'erc-mode) (current-buffer)) + (car (erc-buffer-filter #'erc--server-buffer-p))))) + (with-current-buffer buf + (erc-speedbar--ensure 'force))))) + ((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) + (remove-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) + (remove-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) + (when erc-track-mode + (setq erc-track--switch-fallback-blockers + (remove '(derived-mode . speedbar-mode) + erc-track--switch-fallback-blockers))) + (erc-speedbar--toggle-nicknames-sidebar -1) + (when-let (((not erc-speedbar--shutting-down-p)) + (arg erc--module-toggle-prefix-arg) + ((numberp arg)) + ((< arg 0))) + (with-current-buffer speedbar-buffer + (dframe-close-frame) + (setq erc-speedbar--hidden-speedbar-frame nil))))) + +(defun erc-speedbar--get-timers () + (cl-remove #'dframe-timer-fn timer-idle-list + :key #'timer--function + :test-not #'eq)) + +(defun erc-speedbar--dframe-controlled (arg) + (when speedbar-buffer + (cl-assert (eq speedbar-buffer (current-buffer)))) + (when (and erc-speedbar--hidden-speedbar-frame (numberp arg) (< arg 0)) + (when erc-nickbar-mode + (let ((erc-speedbar--shutting-down-p t)) + (erc-nickbar-mode -1))) + (setq speedbar-frame erc-speedbar--hidden-speedbar-frame + erc-speedbar--hidden-speedbar-frame nil) + ;; It's unknown whether leaving the frame invisible interferes + ;; with the upstream teardown sequence. + (when (display-graphic-p) + (make-frame-visible speedbar-frame)) + (speedbar-frame-mode arg) ; -1 + ;; As of Emacs 29, `dframe-set-timer' can't remove `dframe-timer'. + (cl-assert (= 1 (length (erc-speedbar--get-timers))) t) + (cancel-function-timers #'dframe-timer-fn) + ;; `dframe-close-frame' kills the buffer but no function in + ;; erc-speedbar.el resets this to nil. + (setq speedbar-buffer nil))) + +(defun erc-speedbar-toggle-nicknames-window-lock (arg) + "Toggle whether nicknames window is selectable with \\[other-window]. +When arg is a number, lock the window if non-negative, otherwise +unlock." + (interactive "P") + (unless erc-nickbar-mode + (user-error "`erc-nickbar-mode' inactive")) + (when-let ((window (get-buffer-window speedbar-buffer))) + (let ((val (cond ((natnump arg) t) + ((integerp arg) nil) + (t (not (window-parameter window + 'no-other-window)))))) + (set-window-parameter window 'no-other-window val) + (unless (numberp arg) + (message "nick-window: %s" (if val "protected" "selectable")))))) + + +;;;; Nicks integration + +(declare-function erc-nicks--highlight "erc-nicks" (nickname &optional face)) + +(defun erc-speedbar--compose-nicks-face (orig buffer user cuser) + (require 'erc-nicks) + (let ((rv (funcall orig buffer user cuser))) + (if-let ((nick (erc-server-user-nickname user)) + (face (with-current-buffer buffer + (erc-nicks--highlight nick rv))) + ((not (eq face erc-button-nickname-face)))) + (cons face (ensure-list rv)) + rv))) + + (provide 'erc-speedbar) ;;; erc-speedbar.el ends here ;; |