;;; rcirc-menu --- a menu of all your rcirc connections ;; Copyright (C) 2017 Free Software Foundation, Inc. ;; Author: Alex Schroeder ;; Maintainer: Alex Schroeder ;; Created: 2017-08-10 ;; Version: 1.0 ;; Keywords: comm ;; This program is free software: you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by the Free ;; Software Foundation, either version 3 of the License, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for ;; more details. ;; ;; You should have received a copy of the GNU General Public License along ;; with GNU Emacs. If not, see . ;;; Commentary: ;; If you are connected to too many channels, `rcirc-track-minor-mode' ;; is useless because the modeline is too short. Bind `rcirc-menu' to ;; a key instead: ;; ;; (global-set-key (kbd "C-c r") 'rcirc-menu) ;;; Code: (require 'rcirc) ;;;###autoload (defun rcirc-menu () "Show a list of all your `rcirc' buffers." (interactive) (switch-to-buffer (get-buffer-create "*Rcirc Menu*")) (rcirc-menu-mode) (rcirc-menu-refresh) (tabulated-list-print)) (defvar rcirc-menu-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap))) (set-keymap-parent map tabulated-list-mode-map) (define-key map "v" 'Buffer-menu-select) (define-key map "2" 'Buffer-menu-2-window) (define-key map "1" 'Buffer-menu-1-window) (define-key map "f" 'Buffer-menu-this-window) (define-key map "e" 'Buffer-menu-this-window) (define-key map "\C-m" 'Buffer-menu-this-window) (define-key map "o" 'Buffer-menu-other-window) (define-key map "\C-o" 'Buffer-menu-switch-other-window) (define-key map "d" 'Buffer-menu-delete) (define-key map "k" 'Buffer-menu-delete) (define-key map "\C-k" 'Buffer-menu-delete) (define-key map "\C-d" 'Buffer-menu-delete-backwards) (define-key map "x" 'Buffer-menu-execute) (define-key map " " 'next-line) (define-key map "\177" 'Buffer-menu-backup-unmark) (define-key map "u" 'Buffer-menu-unmark) (define-key map "m" 'Buffer-menu-mark) (define-key map "b" 'Buffer-menu-bury) (define-key map (kbd "M-s a C-s") 'Buffer-menu-isearch-buffers) (define-key map (kbd "M-s a M-C-s") 'Buffer-menu-isearch-buffers-regexp) (define-key map (kbd "M-s a C-o") 'Buffer-menu-multi-occur) (define-key map "c" 'rcirc-menu-catchup) (define-key map "C" 'rcirc-menu-catchup-all) (define-key map [mouse-2] 'Buffer-menu-mouse-select) (define-key map [follow-link] 'mouse-face) (define-key map [menu-bar rcirc-menu-mode] (cons (purecopy "Rcirc-Menu") menu-map)) (bindings--define-key menu-map [quit] '(menu-item "Quit" quit-window :help "Remove the rcirc menu from the display")) (bindings--define-key menu-map [rev] '(menu-item "Refresh" revert-buffer :help "Refresh the *Rcirc Menu* buffer contents")) (bindings--define-key menu-map [s0] menu-bar-separator) (bindings--define-key menu-map [cata] '(menu-item "Catch up All" rcirc-menu-catchup-all :help "Mark all buffers as read")) (bindings--define-key menu-map [cat] '(menu-item "Catch up" rcirc-menu-catchup :help "Mark this buffer as read")) (bindings--define-key menu-map [s1] menu-bar-separator) (bindings--define-key menu-map [sel] '(menu-item "Select Marked" Buffer-menu-select :help "Select this line's buffer; also display buffers marked with `>'")) (bindings--define-key menu-map [bm2] '(menu-item "Select Two" Buffer-menu-2-window :help "Select this line's buffer, with previous buffer in second window")) (bindings--define-key menu-map [bm1] '(menu-item "Select Current" Buffer-menu-1-window :help "Select this line's buffer, alone, in full frame")) (bindings--define-key menu-map [ow] '(menu-item "Select in Other Window" Buffer-menu-other-window :help "Select this line's buffer in other window, leaving buffer menu visible")) (bindings--define-key menu-map [tw] '(menu-item "Select in Current Window" Buffer-menu-this-window :help "Select this line's buffer in this window")) (bindings--define-key menu-map [s2] menu-bar-separator) (bindings--define-key menu-map [is] '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp :help "Search for a regexp through all marked buffers using Isearch")) (bindings--define-key menu-map [ir] '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers :help "Search for a string through all marked buffers using Isearch")) (bindings--define-key menu-map [mo] '(menu-item "Multi Occur Marked Buffers..." Buffer-menu-multi-occur :help "Show lines matching a regexp in marked buffers using Occur")) (bindings--define-key menu-map [s3] menu-bar-separator) (bindings--define-key menu-map [by] '(menu-item "Bury" Buffer-menu-bury :help "Bury the buffer listed on this line")) (bindings--define-key menu-map [ex] '(menu-item "Execute" Buffer-menu-execute :help "Delete buffers marked with k commands")) (bindings--define-key menu-map [s4] menu-bar-separator) (bindings--define-key menu-map [delb] '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards :help "Mark buffer on this line to be deleted by x command and move up one line")) (bindings--define-key menu-map [del] '(menu-item "Mark for Delete" Buffer-menu-delete :help "Mark buffer on this line to be deleted by x command")) (bindings--define-key menu-map [umk] '(menu-item "Unmark" Buffer-menu-unmark :help "Cancel all requested operations on buffer on this line and move down")) (bindings--define-key menu-map [mk] '(menu-item "Mark" Buffer-menu-mark :help "Mark buffer on this line for being displayed by v command")) map) "Local keymap for `rcirc-menu-mode' buffers.") (define-derived-mode rcirc-menu-mode tabulated-list-mode "Rcirc Menu" "Major mode for Rcirc Menu buffers. The Rcirc Menu is invoked by the command \\[rcirc-menu]. Columns: T - this buffer has a target, a live connection P - buffer priority In Rcirc Menu mode, the following commands are defined: \\ \\[quit-window] Remove the Buffer Menu from the display. \\[tabulated-list-sort] sorts buffers according to the current column. With a numerical argument, sort by that column. \\[Buffer-menu-this-window] Select current line's buffer in place of the buffer menu. \\[Buffer-menu-other-window] Select that buffer in another window, so the Buffer Menu remains visible in its window. \\[Buffer-menu-switch-other-window] Make another window display that buffer. \\[Buffer-menu-mark] Mark current line's buffer to be displayed. \\[Buffer-menu-select] Select current line's buffer. Also show buffers marked with m, in other windows. \\[Buffer-menu-1-window] Select that buffer in full-frame window. \\[Buffer-menu-2-window] Select that buffer in one window, together with the buffer selected before this one in another window. \\[Buffer-menu-isearch-buffers] Incremental search in the marked buffers. \\[Buffer-menu-isearch-buffers-regexp] Isearch for regexp in the marked buffers. \\[Buffer-menu-multi-occur] Show lines matching regexp in the marked buffers. \\[Buffer-menu-delete] Mark that buffer to be deleted, and move down. \\[Buffer-menu-delete-backwards] Mark that buffer to be deleted, and move up. \\[Buffer-menu-execute] Delete or save marked buffers. \\[Buffer-menu-unmark] Remove all marks from current line. With prefix argument, also move up one line. \\[Buffer-menu-backup-unmark] Back up a line and remove marks. \\[revert-buffer] Update the list of buffers. \\[Buffer-menu-bury] Bury the buffer listed on this line." (add-hook 'tabulated-list-revert-hook 'rcirc-menu-refresh)) (defun rcirc-menu-refresh () "Refresh the list of buffers." ;; Set up `tabulated-list-format'. (setq tabulated-list-format (vector '("T" 1 t) '("P" 1 rcirc-menu-sort-priority) '("Target" 30 t) '("Server" 20 t) '("Activity" 10 rcirc-menu-sort-activity)) tabulated-list-sort-key '("Activity")) ;; Collect info for each buffer we're interested in. (let* ((pair (rcirc-split-activity rcirc-activity)) (lopri (car pair)) (hipri (cdr pair)) entries) (dolist (buf (buffer-list)) (with-current-buffer buf (when (eq major-mode 'rcirc-mode) (push (list buf (vector (if rcirc-target "•" " ") ;; "T" (cond ((memq buf hipri) "↑") ((memq buf lopri) "↓") (t " ")) ;; "P" (or rcirc-target (car (split-string (buffer-name) "@"))) ;; "Target" (with-current-buffer rcirc-server-buffer rcirc-server-name) ;; "Server" (rcirc-menu-activity))) ;; "Activity" entries)))) (setq tabulated-list-entries (nreverse entries))) (tabulated-list-init-header)) (defun rcirc-menu-sort-priority (&rest args) "Sort by priority. ARGS is a list of two elements having the same form as the elements of ‘tabulated-list-entries’." (setq args (mapcar (lambda (v) (let ((s (aref (cadr v) 1))) (cond ((string= s "↑") 1) ((string= s "↓") 3) (t 2)))) args)) (apply '< args)) (defun rcirc-menu-sort-activity (&rest args) "Sort by activity. ARGS is a list of two elements having the same form as the elements of ‘tabulated-list-entries’. At this point, we only have the comma-separated string produced by `rcirc-menu-activity' in the vector. The alternative is to simply visit the buffers and examine `rcirc-activity-types'." (setq args (mapcar (lambda (v) (let ((buf (car v))) (with-current-buffer buf (cond ((memq 'nick rcirc-activity-types) 1) ((memq 'keyword rcirc-activity-types) 2) (rcirc-activity-types 3) (t 4))))) args)) (apply '< args)) (defun rcirc-menu-sort-activity-symbols (&rest args) "Sort by activity symbols. ARGS are symbols from `rcirc-activity-types'." (setq args (mapcar (lambda (v) (cond ((eq v 'nick) 1) ((eq v 'keyword) 2) ((not v) 3) (t 4))) args)) (apply '< args)) (defun rcirc-menu-activity () "Return string describing activity in the current buffer." (mapconcat (lambda (s) (cond ((eq s 'nick) (rcirc-facify "nick" 'rcirc-track-nick)) ((eq s 'keyword) (rcirc-facify "keyword" 'rcirc-track-keyword)) (t "yes"))) (sort (copy-sequence rcirc-activity-types) 'rcirc-menu-sort-activity-symbols) ", ")) (defun rcirc-menu-catchup () "Mark the current buffer or the marked buffers as read. This resets their activity." (interactive) (let* ((this-buffer (list (Buffer-menu-buffer t))) (marked-buffers (Buffer-menu-marked-buffers)) (buffers (or marked-buffers this-buffer))) (dolist (buf buffers) (rcirc-clear-activity buf))) (run-hooks 'tabulated-list-revert-hook) (tabulated-list-print)) (defun rcirc-menu-catchup-all () "Mark all the buffers as read, i.e. no activity." (interactive) (dolist (buf (buffer-list)) (with-current-buffer buf (when rcirc-activity-types (rcirc-clear-activity buf)))) (run-hooks 'tabulated-list-revert-hook) ;; don't move point (tabulated-list-print)) (add-hook 'rcirc-update-activity-string-hook 'rcirc-menu-update) (defun rcirc-menu-update () "Update the Rcirc Menu buffer, if any." (let ((buf (get-buffer "*Rcirc Menu*"))) (when buf (with-current-buffer buf (when (derived-mode-p 'tabulated-list-mode) ;; this will move point (tabulated-list-revert)))))) ;;;; ChangeLog: ;; 2017-08-14 Stefan Monnier ;; ;; * rcirc-menu, rcirc-color: Fix copyright ;; ;; 2017-08-12 Alex Schroeder ;; ;; rcirc-menu.el: explain what T and P are ;; ;; 2017-08-12 Alex Schroeder ;; ;; rcirc-menu.el: guess target when rcirc-target is nil ;; ;; Use the first part of buffer name instead of just showing no name. ;; ;; 2017-08-11 Alex Schroeder ;; ;; rcirc-menu.el: fontify activity column ;; ;; 2017-08-11 Alex Schroeder ;; ;; rcirc-menu.el: catchup marked buffers ;; ;; When catching up, check for marked buffers. If there are any, catch up ;; for each of them. If there are no marked buffers, use the current ;; buffer. ;; ;; 2017-08-11 Alex Schroeder ;; ;; rcirc-menu.el: make rcirc-menu-update more resilient ;; ;; If the buffer doesn't exist, don't create it. If it exists but it ;; doesn't have use a mode derived from tabulated-list-mode, ignore it. If ;; we don't do that, updating the rcirc activity string will call ;; tabulated-list-revert which might throw an error. ;; ;; 2017-08-10 Alex Schroeder ;; ;; rcirc-menu.el: add catching up and updating ;; ;; c and C will now mark a buffer as read. Changes to the rcirc activity ;; string will also update the menu buffer. ;; ;; 2017-08-10 Alex Schroeder ;; ;; Add rcirc-menu ;; (provide 'rcirc-menu) ;;; rcirc-menu.el ends here