X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-unread.el;h=7e950b85a39f6d4475a3b2f6e0a02c53269a11a8;hp=d2e3100570eba9f971a91400e6a40c989e3011be;hb=9c77540d193a4f636488a360f67b84caf416ea03;hpb=b33a8b8e575ad51d50dc09163d1dcb219e0789b9 diff --git a/lisp/riece-unread.el b/lisp/riece-unread.el index d2e3100..7e950b8 100644 --- a/lisp/riece-unread.el +++ b/lisp/riece-unread.el @@ -23,74 +23,156 @@ ;;; Commentary: -;; This add-on displays unread mark ("!") for channels which have -;; "unread messages". +;; This add-on marks channels where new messages are arrived. -;; To use, add the following line to your ~/.riece/init.el: -;; (add-to-list 'riece-addons 'riece-unread t) +;; You can check the unread channels via `C-c g' in the commands +;; buffer, by adding the following lines to ~/.riece/init.el: + +;; (add-hook 'riece-guess-channel-try-functions +;; 'riece-guess-channel-from-unread) ;;; Code: -(eval-when-compile (require 'riece-message)) +(require 'riece-message) +(require 'riece-commands) +(require 'riece-signal) + +(eval-when-compile (require 'riece-highlight)) + +(defgroup riece-unread nil + "Mark unread channels" + :tag "Unread" + :prefix "riece-" + :group 'riece) + +(defface riece-channel-list-unread-face + '((((class color) + (background dark)) + (:foreground "orange")) + (((class color) + (background light)) + (:foreground "firebrick")) + (t + (:bold t))) + "Face used for displaying unread channels." + :group 'riece-highlight-faces) +(defvar riece-channel-list-unread-face 'riece-channel-list-unread-face) + +(unless (riece-facep 'riece-modeline-unread-face) + (make-face 'riece-modeline-unread-face + "Face used for displaying unread channels in modeline.") + (if (featurep 'xemacs) + (set-face-parent 'riece-modeline-unread-face 'modeline)) + (set-face-foreground 'riece-modeline-unread-face + (face-foreground 'riece-channel-list-unread-face))) (defvar riece-unread-channels nil) -(defun riece-unread-display-message-function (message) - (unless (or (riece-message-own-p message) - (equal (riece-message-target message) riece-current-channel)) - (setq riece-unread-channels - (delete (riece-message-target message) riece-unread-channels)) - (add-to-list 'riece-unread-channels - (riece-message-target message)) - (riece-unread-update-channel-list-buffer))) - -(defun riece-unread-channel-switch-hook () - (setq riece-unread-channels - (delete riece-current-channel - riece-unread-channels)) - (riece-unread-update-channel-list-buffer)) - -(defun riece-unread-update-channel-list-buffer () - (if riece-channel-list-buffer-mode - (save-excursion - (set-buffer riece-channel-list-buffer) - (let ((inhibit-read-only t) - buffer-read-only) - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "\\( ?[0-9]+:\\)\\([ !]\\)\\(.+\\)") - (let ((channel (match-string 3))) - (replace-match - (concat "\\1" - (if (member channel riece-unread-channels) - "!" - " ") - "\\3")))) - (forward-line)))))) - +(defvar riece-unread-enabled nil) + +(defconst riece-unread-description + "Mark channels where \"unread\" messages arrived") + +(defun riece-unread-after-display-message-function (message) + (if riece-unread-enabled + (let ((target (if (riece-message-private-p message) + (riece-message-speaker message) + (riece-message-target message)))) + (unless (or (riece-message-own-p message) + (riece-message-type message) + (riece-identity-equal target riece-current-channel) + (riece-identity-member target riece-unread-channels)) + (setq riece-unread-channels (cons target riece-unread-channels)) + (riece-emit-signal 'channel-list-changed))))) + +(defun riece-unread-after-switch-to-channel-function (last) + (if riece-unread-enabled + (setq riece-unread-channels + (delete riece-current-channel + riece-unread-channels)))) + +(defun riece-unread-format-identity-for-channel-list-buffer (index identity) + (if (and riece-unread-enabled + (riece-identity-member identity riece-unread-channels)) + (concat (format "%2d:!" index) + (riece-format-identity identity)))) + +(defun riece-unread-format-identity-for-channel-list-indicator (index identity) + (if (and riece-unread-enabled + (riece-identity-member identity riece-unread-channels)) + (let ((string (riece-format-identity identity)) + (start 0)) + ;; Escape % -> %%. + (while (string-match "%" string start) + (setq start (1+ (match-end 0)) + string (replace-match "%%" nil nil string))) + (list (format "%d:" index) + (riece-propertize-modeline-string + string 'face 'riece-modeline-unread-face))))) + (defun riece-unread-switch-to-channel () (interactive) - (if (car riece-unread-channels) - (riece-command-switch-to-channel (car riece-unread-channels)) + (if riece-unread-channels + (let ((channel (car riece-unread-channels))) + (if (riece-identity-member channel riece-current-channels) + (riece-command-switch-to-channel channel) + (setq riece-unread-channels + (delete channel riece-unread-channels)) + (riece-unread-switch-to-channel))) (error "No unread channel!"))) -(defvar riece-command-mode-map) -(defvar riece-dialogue-mode-map) -(defvar riece-channel-list-mode-map) +(defun riece-guess-channel-from-unread () + riece-unread-channels) + +(defun riece-unread-requires () + (let (requires) + (if (memq 'riece-highlight riece-addons) + (setq requires (cons 'riece-highlight requires))) +;;; (if (memq 'riece-guess riece-addons) +;;; (setq requires (cons 'riece-guess requires))) + requires)) (defun riece-unread-insinuate () (add-hook 'riece-after-display-message-functions - 'riece-unread-display-message-function) - (add-hook 'riece-channel-switch-hook - 'riece-unread-channel-switch-hook) - (add-hook 'riece-update-buffers-hook - 'riece-unread-update-channel-list-buffer) + 'riece-unread-after-display-message-function) + (add-hook 'riece-after-switch-to-channel-functions + 'riece-unread-after-switch-to-channel-function) + (add-hook 'riece-format-identity-for-channel-list-buffer-functions + 'riece-unread-format-identity-for-channel-list-buffer) + (add-hook 'riece-format-identity-for-channel-list-indicator-functions + 'riece-unread-format-identity-for-channel-list-indicator) + (if (memq 'riece-highlight riece-addons) + (setq riece-channel-list-mark-face-alist + (cons '(?! . riece-channel-list-unread-face) + riece-channel-list-mark-face-alist))) +;;; (if (memq 'riece-guess riece-addons) +;;; (add-hook 'riece-guess-channel-try-functions +;;; 'riece-guess-channel-from-unread)) + ) + +(defvar riece-command-mode-map) +(defvar riece-dialogue-mode-map) +(defvar riece-channel-list-mode-map) +(defun riece-unread-enable () (define-key riece-command-mode-map "\C-c\C-u" 'riece-unread-switch-to-channel) (define-key riece-dialogue-mode-map "u" 'riece-unread-switch-to-channel) (define-key riece-channel-list-mode-map - "u" 'riece-unread-switch-to-channel)) + "u" 'riece-unread-switch-to-channel) + (setq riece-unread-enabled t) + (riece-emit-signal 'channel-list-changed)) + +(defun riece-unread-disable () + (define-key riece-command-mode-map + "\C-c\C-u" nil) + (define-key riece-dialogue-mode-map + "u" nil) + (define-key riece-channel-list-mode-map + "u" nil) + (setq riece-unread-channels nil + riece-unread-enabled nil) + (riece-emit-signal 'channel-list-changed)) (provide 'riece-unread)