;;; erc-print-names.el --- Pretty-print the users on the current channel. ;; Author: Mark Triggs ;; This file 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 2, or (at your option) ;; any later version. ;; This file 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; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; This code pretty-prints the contents of the `erc-channel-users' hash table. ;; The approach simple: ;; ;; * Convert the `erc-channel-users' hash into an equivalent list-based ;; structure. ;; * Call zero or more "filter" functions that take the list-based channel ;; users and return a modified copy. ;; * Call a formatter function to format the name list as a string. ;; * Print it. ;; ;; Filter functions are intended to allow you to change how the nickname list ;; is displayed. For example, you might have filter functions to sort the ;; list in some way, change the faces of entries, etc.. ;; ;; The list-based `erc-channel-users' has the following form: ;; ;; (("nickname-1" [erc-server-user struct] [erc-channel-user struct]) ;; ("nickname-2" [erc-server-user struct] [erc-channel-user struct]) ;; ... ;; ("nickname-n" [erc-server-user struct] [erc-channel-user struct])) ;; ;; Filter functions will generally want to manipulate the string at the car of ;; each entry. ;; ;;; Code: (defvar erc-p-n-filters '() "Filter functions that will be applied to the user list. Each should take a list of the form: ((\"nickname-1\" [erc-server-user struct] [erc-channel-user struct]) (\"nickname-2\" [erc-server-user struct] [erc-channel-user struct]) ... (\"nickname-n\" [erc-server-user struct] [erc-channel-user struct])) and return a modified copy.") (defvar erc-p-n-formatter-function 'erc-p-n-format-nicks-as-columns) (defun erc-p-n-channel-users-to-list (erc-channel-users) "Convert the ERC-CHANNEL-USERS hash into an equivalent list-based form." (let ((alist '())) (maphash (lambda (key value) (push (list (erc-server-user-nickname (car value)) (car value) (cdr value)) alist)) erc-channel-users) alist)) (defun erc-p-n-apply-filters (erc-channel-users-list) "Apply all the filters in `erc-p-n-filters' to ERC-CHANNEL-USERS-LIST." (reduce (lambda (users filter) (funcall filter users)) erc-p-n-filters :initial-value erc-channel-users-list)) (defun erc-p-n-group-list (list num) "Group LIST into sublists of length NUM." (cond ((< num 1) (error "NUM must be >= 1")) ((null list) '()) (t (cons (remove nil (subseq list 0 num)) (erc-p-n-group-list (subseq list num) num))))) (defvar erc-p-n-format-nicks-column-width nil "The column width used when printing the nickname list.") (defun erc-p-n-truncate-string (string length) (if (< length (length string)) (subseq string 0 length) string)) (defun erc-p-n-format-nicks-as-columns (erc-channel-users-list &optional width) "Print the nicknames from ERC-CHANNEL-USERS-LIST in columns of WIDTH." (let* ((width (1- (or width erc-p-n-format-nicks-column-width (floor (/ (or fill-column window-width) 5))))) (columns (floor (/ (or fill-column window-width) width)))) (let ((columns (group-list (mapcar 'car erc-channel-users-list) columns))) (format " %s\n" (mapconcat #'(lambda (column) (mapconcat #'(lambda (nickname) (format (format "%%-%ds" width) (erc-p-n-truncate-string nickname width))) column " ")) columns "\n "))))) (defun erc-cmd-SHOWUSERS () (erc-display-line (funcall erc-p-n-formatter-function (erc-p-n-apply-filters (erc-p-n-channel-users-to-list erc-channel-users))) (erc-get-buffer (erc-default-target)))) ;; Hook everything in to run automatically when the NAMES list is received. (define-erc-response-handler (353) "NAMES notice." nil (let ((channel (third (erc-response.command-args parsed))) (users (erc-response.contents parsed))) (erc-with-buffer (channel proc) (erc-channel-receive-names users)))) ;; Once the list of channel users is up to date, invoke the printer. (define-erc-response-handler (366) "End of names" nil (let ((channel (cadr (erc-response.command-args parsed)))) (with-current-buffer (erc-get-buffer channel proc) (erc-cmd-SHOWUSERS)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tests ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro erc-p-n-ignore (&rest body) nil) (erc-p-n-ignore (progn ;; Tiny ad-hoc test framework (defvar *erc-p-n-tests* '()) (defun erc-p-n-add-test (name test-function) (setq *erc-p-n-tests* (remove (assoc name *erc-p-n-tests*) *erc-p-n-tests*)) (push (cons name test-function) *erc-p-n-tests*)) (defun erc-p-n-run-tests () (let ((failed '())) (dolist (test *erc-p-n-tests*) (unless (ignore-errors (funcall (cdr test))) (push test failed))) (if (not failed) t (message "Tests failed: %s" failed) nil))) ;; Unit tests (defvar *erc-p-n-test-channel-users* (let ((erc-channel-users (make-hash-table :test 'equal)) (data `(("mst" ,(cons (make-erc-server-user :nickname "mst") (make-erc-channel-user :op t))) ("foo" ,(cons (make-erc-server-user :nickname "Foo") (make-erc-channel-user :voice t))) ("mark" ,(cons (make-erc-server-user :nickname "Mark") (make-erc-channel-user)))))) (mapc #'(lambda (data) (puthash (car data) (cadr data) erc-channel-users)) data) erc-channel-users)) ;; erc-p-n-channel-users-to-list (erc-p-n-add-test 'erc-p-n-channel-users-to-list:empty #'(lambda () (null (erc-p-n-channel-users-to-list (make-hash-table :test 'equal))))) (erc-p-n-add-test 'erc-p-n-channel-users-to-list:normal #'(lambda () (let ((erc-channel-users *erc-p-n-test-channel-users*)) (let ((result (erc-p-n-channel-users-to-list erc-channel-users))) (catch 'passed (maphash #'(lambda (key data) (let* ((nickname (erc-server-user-nickname (car data))) (entry (assoc nickname result))) (unless (and entry (erc-server-user-p (cadr entry)) (erc-channel-user-p (caddr entry)) (string= (car entry) (erc-server-user-nickname (cadr entry)))) (throw 'passed nil)))) erc-channel-users) t))))) ;; erc-p-n-apply-filters (erc-p-n-add-test 'erc-p-n-apply-filters:empty #'(lambda () (null (erc-p-n-apply-filters '())))) (erc-p-n-add-test 'erc-p-n-apply-filters:no-filters #'(lambda () (let* ((list (erc-p-n-channel-users-to-list *erc-p-n-test-channel-users*)) (erc-p-n-filters '())) (equal (erc-p-n-apply-filters list) list)))) (erc-p-n-add-test 'erc-p-n-apply-filters:sort #'(lambda () (let* ((list (erc-p-n-channel-users-to-list *erc-p-n-test-channel-users*)) (erc-p-n-filters `(,(lambda (list) (sort list #'(lambda (entry1 entry2) (string< (car entry1) (car entry2)))))))) (let ((result-order (mapcar 'car (erc-p-n-apply-filters list)))) (equal result-order '("Foo" "Mark" "mst")))))) ;; erc-p-n-group-list (erc-p-n-add-test 'erc-p-n-group-list:empty #'(lambda () (null (erc-p-n-group-list '() 5)))) (erc-p-n-add-test 'erc-p-n-group-list:simple #'(lambda () (equal (erc-p-n-group-list '(one two three) 1) '((one) (two) (three))))) (erc-p-n-add-test 'erc-p-n-group-list:garbage #'(lambda () (condition-case e (progn (erc-p-n-group-list '(one two three) 0) nil) (error () t)))) (erc-p-n-add-test 'erc-p-n-group-list:simple-2 #'(lambda () (equal (erc-p-n-group-list '(one two three) 2) '((one two) (three))))) ;; erc-p-n-format-nicks-as-columns (erc-p-n-add-test 'erc-p-n-format-nicks-as-columns:empty #'(lambda () (string= (erc-p-n-format-nicks-as-columns '()) " \n"))) (erc-p-n-add-test 'erc-p-n-format-nicks-as-columns:simple #'(lambda () (string= (erc-p-n-format-nicks-as-columns '(("Mark") ("Foo") ("mst")) 5) " Mark Foo mst \n"))) (erc-p-n-add-test 'erc-p-n-format-nicks-as-columns:multi-rows #'(lambda () (string= (let ((fill-column 15)) (erc-p-n-format-nicks-as-columns '(("Mark") ("Foo") ("mst") ("Mark") ("Foo") ("mst") ("Mark") ("Foo") ("mst")) 5)) " Mark Foo mst \n Mark Foo mst \n Mark Foo mst \n"))) (erc-p-n-add-test 'erc-p-n-format-nicks-as-columns:truncate #'(lambda () (string= (let ((fill-column 15)) (erc-p-n-format-nicks-as-columns '(("Markaaaaaaa") ("Fooaaaaaaaa") ("mstaaaaaaa") ("Mark") ("Foo") ("mst") ("Mark") ("Foo") ("mst")) 5)) " Mark Fooa msta\n Mark Foo mst \n Mark Foo mst \n"))) (when (boundp 'unit-test-command) (setq unit-test-command 'erc-p-n-run-tests)) )) (provide 'erc-print-names) ;;; erc-print-names.el ends here