;; 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") ; FIXME sync on release
+ :type 'integer)
+
(defcustom erc-speedbar-sort-users-type 'activity
"How channel nicknames are sorted.
(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") ; FIXME sync on release
+ :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") ; FIXME sync on release
+ :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.")
(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 ()
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.
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
'angle ?i nil nil
(concat "Topic: " topic) nil nil nil
(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
(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))
(op (and cuser (erc-channel-user-op cuser)))
(nick-str (concat (if op "@" "") (if voice "+" "") 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)
(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)
+(declare-function erc-status-sidebar-mode--unhook "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)
+ (when-let ((window (get-buffer-window speedbar-buffer)))
+ (set-window-parameter window 'no-other-window nil)
+ (internal-show-cursor window t))))
+
+(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
+ 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)))
+ (erc-speedbar-close-nicknames-window nil)
+ (when (or (not force) (>= arg 0))
+ (with-selected-frame speedbar-frame
+ (erc-speedbar--emulate-sidebar-set-window-preserve-size)))))
+ (when (or (not force) (>= arg 0))
+ (let ((speedbar-frame-parameters (backquote-list*
+ '(visibility . nil)
+ '(no-other-frame . t)
+ speedbar-frame-parameters))
+ (speedbar-after-create-hook #'erc-speedbar--emulate-sidebar))
+ (erc-speedbar-browser)
+ ;; 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))))))
+
+(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))
+ (erc-speedbar--toggle-nicknames-sidebar +1)
+ (speedbar-enable-update)))
+
+;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t)
+(define-erc-module nickbar nil
+ "Show nicknames 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 an occurrence, and can reproduce it, please file a bug
+report with \\[erc-bug]."
+ ((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure)
+ (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))))))
+ (if speedbar-buffer
+ (erc-speedbar--ensure 'force)
+ (setq erc-nickbar-mode nil)
+ (when (derived-mode-p 'erc-mode)
+ (erc-error "Not initializing `erc-nickbar-mode' in %s"
+ (current-buffer))))))
+ ((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure)
+ (speedbar-disable-update)
+ (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 ((arg erc--module-toggle-prefix-arg)
+ ((numberp arg))
+ ((< arg 0)))
+ (erc-speedbar-close-nicknames-window 'kill))))
+
+(defun erc-speedbar--dframe-controlled (arg)
+ (when (and erc-speedbar--hidden-speedbar-frame (numberp arg) (< arg 0))
+ (when erc-nickbar-mode
+ (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 procedure.
+ (when (display-graphic-p)
+ (make-frame-visible speedbar-frame))
+ (speedbar-frame-mode arg)
+ (when speedbar-buffer
+ (kill-buffer speedbar-buffer)
+ (setq speedbar-buffer nil))))
+
+(defun erc-speedbar-toggle-nicknames-window-lock ()
+ "Toggle whether nicknames window is selectable with \\[other-window]."
+ (interactive)
+ (unless erc-nickbar-mode
+ (user-error "`erc-nickbar-mode' inactive"))
+ (when-let ((window (get-buffer-window speedbar-buffer)))
+ (let ((val (window-parameter window 'no-other-window)))
+ (set-window-parameter window 'no-other-window (not val))
+ (message "nick-window: %s" (if val "selectable" "protected")))))
+
+(defun erc-speedbar-close-nicknames-window (kill)
+ (interactive "P")
+ (if kill
+ (with-current-buffer speedbar-buffer
+ (dframe-close-frame)
+ (cl-assert (not erc-nickbar-mode))
+ (setq erc-speedbar--hidden-speedbar-frame nil))
+ (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)))))
+
+
+;;;; 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
;;
(erc-status-sidebar-kill)
(should-not (get-buffer "*ERC Status*"))))))
+;; We can't currently run this on EMBA because it needs a usable
+;; terminal, and we lack a fixture for that. Please try running this
+;; test interactively with both graphical Emacs and non.
+(declare-function erc-nickbar-mode "erc-speedbar" (arg))
+(declare-function erc-speedbar-close-nicknames-window "erc-speedbar" (kill))
+(declare-function speedbar-timer-fn "speedbar" nil)
+(defvar erc-nickbar-mode)
+(defvar speedbar-buffer)
+
+(ert-deftest erc-scenarios-status-sidebar--nickbar ()
+ :tags '(:unstable :expensive-test)
+ (when noninteractive (ert-skip "Interactive only"))
+
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/gapless-connect")
+ (erc-server-flood-penalty 0.1)
+ (erc-server-flood-penalty erc-server-flood-penalty)
+ (erc-modules `(nickbar ,@erc-modules))
+ (dumb-server (erc-d-run "localhost" t 'foonet 'barnet))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to two different endpoints")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "foonet:changeme"
+ :full-name "tester")
+ (funcall expect 10 "MOTD File is missing"))
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "barnet:changeme"
+ :full-name "tester")
+ (funcall expect 10 "marked as being away")))
+
+ (erc-d-t-wait-for 20 (get-buffer "#bar"))
+ (with-current-buffer (pop-to-buffer "#bar")
+ (funcall expect 10 "was created on")
+ (funcall expect 2 "his second fit")
+ (erc-d-t-wait-for 10 (and speedbar-buffer (get-buffer speedbar-buffer)))
+ (speedbar-timer-fn)
+ (with-current-buffer speedbar-buffer
+ (funcall expect 10 "#bar (3)")
+ (funcall expect 10 '(| "@mike" "joe"))
+ (funcall expect 10 '(| "@mike" "joe"))
+ (funcall expect 10 "tester")))
+
+ (erc-d-t-wait-for 20 (get-buffer "#foo"))
+ (with-current-buffer (pop-to-buffer "#foo")
+ (delete-other-windows)
+ (funcall expect 10 "was created on")
+ (funcall expect 2 "no use of him")
+ (speedbar-timer-fn)
+ (with-current-buffer speedbar-buffer
+ (funcall expect 10 "#foo (3)")
+ (funcall expect 10 '(| "alice" "@bob"))
+ (funcall expect 10 '(| "alice" "@bob"))
+ (funcall expect 10 "tester")))
+
+ (with-current-buffer "#foo"
+ (ert-info ("Core toggle and kill commands work")
+ ;; Avoid using API, e.g., `erc-status-sidebar-buffer-exists-p',
+ ;; etc. for testing commands that call those same functions.
+ (erc-nickbar-mode -1)
+ (should-not (and speedbar-buffer
+ (get-buffer-window speedbar-buffer)))
+ (erc-nickbar-mode +1)
+ (should (and speedbar-buffer
+ (get-buffer-window speedbar-buffer)))
+ (should (get-buffer " SPEEDBAR"))
+ (erc-speedbar-close-nicknames-window 'kill)
+ (should-not (get-buffer " SPEEDBAR"))
+ (should-not erc-nickbar-mode)
+ (should-not (cdr (frame-list)))))))
+
;;; erc-scenarios-status-sidebar.el ends here
projects / emacs.git / commitdiff