Prevent an args-out-of-range error during login/out
[riece] / lisp / riece-unread.el
1 ;;; riece-unread.el --- mark channels where new messages arrived -*- lexical-binding: t -*-
2 ;; Copyright (C) 1998-2003 Daiki Ueno
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: IRC, riece
6
7 ;; This file is part of Riece.
8
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02110-1301, USA.
23
24 ;;; Commentary:
25
26 ;; NOTE: This is an add-on module for Riece.
27
28 ;; This add-on marks channels where new messages arrived.
29
30 ;; You can check the unread channels via `C-c g' in the commands
31 ;; buffer, by adding the following lines to ~/.riece/init.el:
32
33 ;;   (add-hook 'riece-guess-channel-try-functions
34 ;;             'riece-guess-channel-from-unread)
35
36 ;;; Code:
37
38 (require 'riece-message)
39 (require 'riece-commands)
40 (require 'riece-signal)
41 (require 'riece-highlight)
42
43 (defgroup riece-unread nil
44   "Mark unread channels."
45   :tag "Unread"
46   :prefix "riece-"
47   :group 'riece)
48
49 (defface riece-channel-list-unread-face
50   '((((class color)
51       (background dark))
52      (:foreground "orange"))
53     (((class color)
54       (background light))
55      (:foreground "firebrick"))
56     (t
57      (:bold t)))
58   "Face used for displaying unread channels."
59   :group 'riece-highlight-faces)
60 (defvar riece-channel-list-unread-face 'riece-channel-list-unread-face)
61
62 (unless (riece-facep 'riece-modeline-unread-face)
63   ;; In Emacs, set-face-doc-string is an alias to
64   ;; set-face-documentation, but we use the former since it is
65   ;; available in both Emacs and XEmacs.
66   (make-face 'riece-modeline-unread-face)
67   (set-face-doc-string
68    'riece-modeline-unread-face
69    "Face used for displaying unread channels in modeline.")
70   (if (featurep 'xemacs)
71       (set-face-parent 'riece-modeline-unread-face 'modeline))
72   (set-face-foreground 'riece-modeline-unread-face
73                        (face-foreground 'riece-channel-list-unread-face)))
74
75 (defvar riece-unread-channels nil)
76
77 (defconst riece-unread-description
78   "Mark channels where new messages arrived.")
79
80 (defun riece-unread-after-display-message-function (message)
81   (if (get 'riece-unread 'riece-addon-enabled)
82       (let ((target (if (riece-message-private-p message)
83                         (riece-message-speaker message)
84                       (riece-message-target message))))
85         (unless (or (riece-message-own-p message)
86                     (riece-message-type message)
87                     (riece-identity-equal target riece-current-channel)
88                     (riece-identity-member target riece-unread-channels))
89           (setq riece-unread-channels (cons target riece-unread-channels))
90           (riece-emit-signal 'channel-list-changed)))))
91
92 (defun riece-unread-after-switch-to-channel-function (_last)
93   (if (get 'riece-unread 'riece-addon-enabled)
94       (setq riece-unread-channels
95             (delq (car (riece-identity-member riece-current-channel
96                                               riece-unread-channels))
97                   riece-unread-channels))))
98
99 (defun riece-unread-format-identity-for-channel-list-buffer (index identity)
100   (if (and (get 'riece-unread 'riece-addon-enabled)
101            (riece-identity-member identity riece-unread-channels))
102       (concat (format "%2d:!" index)
103               (riece-format-identity identity))))
104
105 (defun riece-unread-format-identity-for-channel-list-indicator (index identity)
106   (if (and (get 'riece-unread 'riece-addon-enabled)
107            (riece-identity-member identity riece-unread-channels))
108       (let ((string (riece-format-identity identity))
109             (start 0))
110         ;; Escape % -> %%.
111         (while (string-match "%" string start)
112           (setq start (1+ (match-end 0))
113                 string (replace-match "%%" nil nil string)))
114         (list (format "%d:" index)
115               (riece-propertize-modeline-string
116                string 'face 'riece-modeline-unread-face)))))
117
118 (defun riece-unread-switch-to-channel ()
119   (interactive)
120   (if riece-unread-channels
121       (let ((channel (car riece-unread-channels)))
122         (if (riece-identity-member channel riece-current-channels)
123             (riece-command-switch-to-channel channel)
124           (setq riece-unread-channels
125                 (delete channel riece-unread-channels))
126           (riece-unread-switch-to-channel)))
127     (error "No unread channel!")))
128
129 (defun riece-guess-channel-from-unread ()
130   (reverse riece-unread-channels))
131
132 (defun riece-unread-requires ()
133   (let (requires)
134     (if (memq 'riece-highlight riece-addons)
135         (setq requires (cons 'riece-highlight requires)))
136     ;; To override riece-history's channel mark in the channel list buffer.
137     (if (memq 'riece-history riece-addons)
138         (setq requires (cons 'riece-history requires)))
139 ;;;    (if (memq 'riece-guess riece-addons)
140 ;;;     (setq requires (cons 'riece-guess requires)))
141     requires))
142
143 (defun riece-unread-insinuate ()
144   (add-hook 'riece-after-display-message-functions
145             'riece-unread-after-display-message-function)
146   (add-hook 'riece-after-switch-to-channel-functions
147             'riece-unread-after-switch-to-channel-function)
148   (add-hook 'riece-format-identity-for-channel-list-buffer-functions
149             'riece-unread-format-identity-for-channel-list-buffer)
150   (add-hook 'riece-format-identity-for-channel-list-indicator-functions
151             'riece-unread-format-identity-for-channel-list-indicator)
152   (if (memq 'riece-highlight riece-addons)
153       (setq riece-channel-list-mark-face-alist
154             (cons '(?! . riece-channel-list-unread-face)
155                   riece-channel-list-mark-face-alist)))
156 ;;;  (if (memq 'riece-guess riece-addons)
157 ;;;      (add-hook 'riece-guess-channel-try-functions
158 ;;;             'riece-guess-channel-from-unread))
159   )
160
161 (defun riece-unread-uninstall ()
162   (remove-hook 'riece-after-display-message-functions
163                'riece-unread-after-display-message-function)
164   (remove-hook 'riece-after-switch-to-channel-functions
165                'riece-unread-after-switch-to-channel-function)
166   (remove-hook 'riece-format-identity-for-channel-list-buffer-functions
167                'riece-unread-format-identity-for-channel-list-buffer)
168   (remove-hook 'riece-format-identity-for-channel-list-indicator-functions
169                'riece-unread-format-identity-for-channel-list-indicator)
170   (setq riece-channel-list-mark-face-alist
171         (delq (assq ?! riece-channel-list-mark-face-alist)
172               riece-channel-list-mark-face-alist))
173 ;;;  (if (memq 'riece-guess riece-addons)
174 ;;;      (add-hook 'riece-guess-channel-try-functions
175 ;;;             'riece-guess-channel-from-unread))
176   )
177
178 (defvar riece-command-mode-map)
179 (defvar riece-dialogue-mode-map)
180 (defvar riece-channel-list-mode-map)
181 (defun riece-unread-enable ()
182   (define-key riece-command-mode-map
183     "\C-c\C-u" 'riece-unread-switch-to-channel)
184   (define-key riece-dialogue-mode-map
185     "u" 'riece-unread-switch-to-channel)
186   (define-key riece-channel-list-mode-map
187     "u" 'riece-unread-switch-to-channel)  
188   (riece-emit-signal 'channel-list-changed))
189
190 (defun riece-unread-disable ()
191   (define-key riece-command-mode-map
192     "\C-c\C-u" nil)
193   (define-key riece-dialogue-mode-map
194     "u" nil)
195   (define-key riece-channel-list-mode-map
196     "u" nil)
197   (setq riece-unread-channels nil)
198   (riece-emit-signal 'channel-list-changed))
199
200 (provide 'riece-unread)
201
202 ;;; riece-unread.el ends here