cgit.sxemacs.org Git - packages/blob - xemacs-packages/erc/erc-track.el

   1 ;;; erc-track.el --- Track modified channel buffers
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6 ;; Keywords: comm, faces
   7 ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcChannelTracking
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Highlights keywords and pals (friends), and hides or highlights fools
  29 ;; (using a dark color).  Add to your ~/.emacs:
  30
  31 ;; (require 'erc-track)
  32 ;; (erc-track-mode 1)
  33
  34 ;; Todo:
  35 ;; * Add extensibility so that custom functions can track
  36 ;;   custom modification types.
  37
  38 (eval-when-compile (require 'cl))
  39 (require 'erc)
  40 (require 'erc-compat)
  41 (require 'erc-match)
  42
  43 ;;; Code:
  44
  45 (defconst erc-track-version "$Revision: 1.86.2.1 $"
  46   "ERC track mode revision")
  47
  48 (defgroup erc-track nil
  49   "Track active buffers and show activity in the modeline."
  50   :group 'erc)
  51
  52 (defcustom erc-track-visibility t
  53   "Where do we look for buffers to determine their visibility?
  54 The value of this variable determines, when a buffer is considered
  55 visible or invisible.  New messages in invisible buffers are tracked,
  56 while switching to visible buffers when they are tracked removes them
  57 from the list.  See also `erc-track-when-inactive-mode'.
  58
  59 Possible values are:
  60
  61 t                - all frames
  62 visible          - all visible frames
  63 nil              - only the selected frame
  64 selected-visible - only the selected frame if it is visible
  65
  66 Activity means that there was no user input in the last 10 seconds."
  67   :group 'erc-track
  68   :type  '(choice (const :tag "All frames" t)
  69                   (const :tag "All visible frames" visible)
  70                   (const :tag "Only the selected frame" nil)
  71                   (const :tag "Only the selected frame if it was active"
  72                          active)))
  73
  74 (defcustom erc-track-exclude nil
  75   "A list targets (channel names or query targets) which should not be tracked."
  76   :group 'erc-track
  77   :type '(repeat string))
  78
  79 (defcustom erc-track-exclude-types '("NICK")
  80   "*List of message types to be ignored.
  81 This list could look like '(\"JOIN\" \"PART\")."
  82   :group 'erc-track
  83   :type 'erc-message-type)
  84
  85 (defcustom erc-track-exclude-server-buffer nil
  86   "*If true, don't perform tracking on the server buffer; this is
  87 useful for excluding all the things like MOTDs from the server and
  88 other miscellaneous functions."
  89   :group 'erc-track
  90   :type 'boolean)
  91
  92 (defcustom erc-track-shorten-start 1
  93   "This number specifies the minimum number of characters a channel name in
  94 the mode-line should be reduced to."
  95   :group 'erc-track
  96   :type 'number)
  97
  98 (defcustom erc-track-shorten-cutoff 4
  99   "All channel names longer than this value will be shortened."
 100   :group 'erc-track
 101   :type 'number)
 102
 103 (defcustom erc-track-shorten-aggressively nil
 104   "*If non-nil, channel names will be shortened more aggressively.
 105 Usually, names are not shortened if this will save only one character.
 106 Example: If there are two channels, #linux-de and #linux-fr, then
 107 normally these will not be shortened.  When shortening aggressively,
 108 however, these will be shortened to #linux-d and #linux-f.
 109
 110 If this variable is set to `max', then channel names will be shortened
 111 to the max.  Usually, shortened channel names will remain unique for a
 112 given set of existing channels.  When shortening to the max, the shortened
 113 channel names will be unique for the set of active channels only.
 114 Example: If there are tow active channels #emacs and #vi, and two inactive
 115 channels #electronica and #folk, then usually the active channels are
 116 shortened to #em and #v.  When shortening to the max, however, #emacs is
 117 not compared to #electronica -- only to #vi, therefore it can be shortened
 118 even more and the result is #e and #v.
 119
 120 This setting is used by `erc-track-shorten-names'."
 121   :group 'erc-track
 122   :type '(choice (const :tag "No" nil)
 123                  (const :tag "Yes" t)
 124                  (const :tag "Max" max)))
 125
 126 (defcustom erc-track-shorten-function 'erc-track-shorten-names
 127   "*This function will be used to reduce the channel names before display.
 128 It takes one argument, CHANNEL-NAMES which is a list of strings.
 129 It should return a list of strings of the same number of elements.
 130 If nil instead of a function, shortening is disabled."
 131   :group 'erc-track
 132   :type '(choice (const :tag "Disabled")
 133                  function))
 134
 135 (defcustom erc-track-use-faces t
 136   "*Use faces in the mode-line.
 137 The faces used are the same as used for text in the buffers.
 138 \(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
 139   :group 'erc-track
 140   :type 'boolean)
 141
 142 (defcustom erc-track-faces-priority-list
 143   '(erc-error-face erc-current-nick-face erc-keyword-face erc-pal-face
 144     erc-nick-msg-face erc-direct-msg-face erc-button erc-dangerous-host-face
 145     erc-default-face erc-action-face erc-nick-default-face erc-fool-face
 146     erc-notice-face erc-input-face erc-prompt-face)
 147   "A list of faces used to highlight active buffer names in the modeline.
 148 If a message contains one of the faces in this list, the buffer name will
 149 be highlighted using that face.  The first matching face is used."
 150   :group 'erc-track
 151   :type '(repeat face))
 152
 153 (defcustom erc-track-priority-faces-only nil
 154   "Only track text highlighted with a priority face.
 155 If you would like to ignore changes in certain channels where there
 156 are no faces corresponding to your `erc-track-faces-priority-list', set
 157 this variable.  You can set a list of channel name strings, so those
 158 will be ignored while all other channels will be tracked as normal.
 159 Other options are 'all, to apply this to all channels or nil, to disable
 160 this feature.
 161 Note: If you have a lot of faces listed in `erc-track-faces-priority-list',
 162 setting this variable might not be very useful."
 163   :group 'erc-track
 164   :type '(choice (const nil)
 165                  (repeat string)
 166                  (const all)))
 167
 168 (defcustom erc-track-position-in-mode-line 'before-modes
 169   "Where to show modified channel information in the mode-line.
 170
 171 Setting this variable only has effects in GNU Emacs versions above 21.3.
 172
 173 Choices are:
 174 'before-modes - add to the beginning of `mode-line-modes'
 175 'after-modes  - add to the end of `mode-line-modes'
 176
 177 Any other value means add to the end of `global-mode-string'."
 178   :group 'erc-track
 179   :type '(choice (const :tag "Just before mode information" before-modes)
 180                  (const :tag "Just after mode information" after-modes)
 181                  (const :tag "After all other information" nil))
 182   :set (lambda (sym val)
 183          (set sym val)
 184          (when (and (boundp 'erc-track-mode)
 185                     erc-track-mode)
 186            (erc-track-remove-from-mode-line)
 187            (erc-track-add-to-mode-line val))))
 188
 189 (defun erc-modified-channels-object (strings)
 190   "Generate a new `erc-modified-channels-object' based on STRINGS.
 191 If STRINGS is nil, we initialize `erc-modified-channels-object' to
 192 an appropriate initial value for this flavor of Emacs."
 193   (if strings
 194       (if (featurep 'xemacs)
 195           (let ((e-m-c-s '("[")))
 196             (push (cons (extent-at 0 (car strings)) (car strings))
 197                   e-m-c-s)
 198             (dolist (string (cdr strings))
 199               (push "," e-m-c-s)
 200               (push (cons (extent-at 0 string) string)
 201                     e-m-c-s))
 202             (push "] " e-m-c-s)
 203             (reverse e-m-c-s))
 204         (concat (if (eq erc-track-position-in-mode-line 'after-modes)
 205                     "[" " [")
 206                 (mapconcat 'identity (nreverse strings) ",")
 207                 (if (eq erc-track-position-in-mode-line 'before-modes)
 208                     "] " "]")))
 209     (if (featurep 'xemacs) '() "")))
 210
 211 (defvar erc-modified-channels-object (erc-modified-channels-object nil)
 212   "Internal object used for displaying modified channels in the mode line.")
 213
 214 (put 'erc-modified-channels-object 'risky-local-variable t); allow properties
 215
 216 (defvar erc-modified-channels-alist nil
 217   "An ALIST used for tracking channel modification activity.
 218 Each element looks like (BUFFER COUNT FACE) where BUFFER is a buffer
 219 object of the channel the entry corresponds to, COUNT is a number
 220 indicating how often activity was noticed, and FACE is the face to use
 221 when displaying the buffer's name.  See `erc-track-faces-priority-list',
 222 and `erc-track-showcount'.
 223
 224 Entries in this list should only happen for buffers where activity occurred
 225 while the buffer was not visible.")
 226
 227 (defcustom erc-track-showcount nil
 228   "If non-nil, count of unseen messages will be shown for each channel."
 229   :type 'boolean
 230   :group 'erc-track)
 231
 232 (defcustom erc-track-showcount-string ":"
 233   "The string to display between buffer name and the count in the mode line.
 234 The default is a colon, resulting in \"#emacs:9\"."
 235   :type 'string
 236   :group 'erc-track)
 237
 238 (defcustom erc-track-switch-from-erc t
 239   "If non-nil, `erc-track-switch-buffer' will return to the last non-erc buffer
 240 when there are no more active channels."
 241   :type 'boolean
 242   :group 'erc-track)
 243
 244 (defcustom erc-track-switch-direction 'oldest
 245   "Direction `erc-track-switch-buffer' should switch.
 246
 247   oldest      -  find oldest active buffer
 248   newest      -  find newest active buffer
 249   leastactive -  find buffer with least unseen messages
 250   mostactive  -  find buffer with most unseen messages."
 251   :group 'erc-track
 252   :type '(choice (const oldest)
 253                  (const newest)
 254                  (const leastactive)
 255                  (const mostactive)))
 256
 257
 258 (defun erc-track-remove-from-mode-line ()
 259   "Remove `erc-track-modified-channels' from the mode-line"
 260   (when (boundp 'mode-line-modes)
 261     (setq mode-line-modes
 262           (remove '(t erc-modified-channels-object) mode-line-modes)))
 263   (when (consp global-mode-string)
 264     (setq global-mode-string
 265           (delq 'erc-modified-channels-object global-mode-string))))
 266
 267 (defun erc-track-add-to-mode-line (position)
 268   "Add `erc-track-modified-channels' to POSITION in the mode-line.
 269 See `erc-track-position-in-mode-line' for possible values."
 270   ;; CVS Emacs has a new format string, and global-mode-string
 271   ;; is very far to the right.
 272   (cond ((and (eq position 'before-modes)
 273               (boundp 'mode-line-modes))
 274          (add-to-list 'mode-line-modes
 275                       '(t erc-modified-channels-object)))
 276         ((and (eq position 'after-modes)
 277               (boundp 'mode-line-modes))
 278          (add-to-list 'mode-line-modes
 279                       '(t erc-modified-channels-object) t))
 280         (t
 281          (when (not global-mode-string)
 282            (setq global-mode-string '(""))) ; Padding for mode-line wart
 283          (add-to-list 'global-mode-string
 284                       'erc-modified-channels-object
 285                       t))))
 286
 287 ;;; Shortening of names
 288
 289 (defun erc-track-shorten-names (channel-names)
 290   "Call `erc-unique-channel-names' with the correct parameters.
 291 This function is a good value for `erc-track-shorten-function'.
 292 The list of all channels is returned by `erc-all-buffer-names'.
 293 CHANNEL-NAMES is the list of active channel names.
 294 Only channel names longer than `erc-track-shorten-cutoff' are
 295 actually shortened, and they are only shortened to a minimum
 296 of `erc-track-shorten-start' characters."
 297   (erc-unique-channel-names
 298    (erc-all-buffer-names)
 299    channel-names
 300    (lambda (s)
 301      (> (length s) erc-track-shorten-cutoff))
 302    erc-track-shorten-start))
 303
 304 (defvar erc-default-recipients)
 305
 306 (defun erc-all-buffer-names ()
 307   "Return all channel or query buffer names.
 308 Note that we cannot use `erc-channel-list' with a nil argument,
 309 because that does not return query buffers."
 310   (save-excursion
 311     (let (result)
 312       (dolist (buf (buffer-list))
 313         (set-buffer buf)
 314         (when (or (eq major-mode 'erc-mode) (eq major-mode 'erc-dcc-chat-mode))
 315           (setq result (cons (buffer-name) result))))
 316       result)))
 317
 318 (defun erc-unique-channel-names (all active &optional predicate start)
 319   "Return a list of unique channel names.
 320 ALL is the list of all channel and query buffer names.
 321 ACTIVE is the list of active buffer names.
 322 PREDICATE is a predicate that should return non-nil if a name needs
 323   no shortening.
 324 START is the minimum length of the name used."
 325   (if (eq 'max erc-track-shorten-aggressively)
 326       ;; Return the unique substrings of all active channels.
 327       (erc-unique-substrings active predicate start)
 328     ;; Otherwise, determine the unique substrings of all channels, and
 329     ;; for every active channel, return the corresponding substring.
 330     ;; Given the names of the active channels, we now need to find the
 331     ;; corresponding short name from the list of all substrings.  To
 332     ;; avoid problems when there are two channels and one is a
 333     ;; substring of the other (notorious examples are #hurd and
 334     ;; #hurd-bunny), every candidate gets the longest possible
 335     ;; substring.
 336     (let ((all-substrings (sort
 337                            (erc-unique-substrings all predicate start)
 338                            (lambda (a b) (> (length a) (length b)))))
 339           result)
 340       (dolist (channel active)
 341         (let ((substrings all-substrings)
 342               candidate
 343               winner)
 344           (while (and substrings (not winner))
 345             (setq candidate (car substrings)
 346                   substrings (cdr substrings))
 347             (when (and (string= candidate
 348                                 (substring channel
 349                                            0
 350                                            (min (length candidate)
 351                                                 (length channel))))
 352                        (not (member candidate result)))
 353               (setq winner candidate)))
 354           (setq result (cons winner result))))
 355       (nreverse result))))
 356
 357 (defun erc-unique-substrings (strings &optional predicate start)
 358   "Return a list of unique substrings of STRINGS."
 359   (if (or (not (numberp start))
 360           (< start 0))
 361       (setq start 2))
 362   (mapcar
 363    (lambda (str)
 364      (let* ((others (delete str (copy-sequence strings)))
 365             (maxlen (length str))
 366             (i (min start
 367                     (length str)))
 368             candidate
 369             done)
 370        (if (and (functionp predicate) (not (funcall predicate str)))
 371            ;; do not shorten if a predicate exists and it returns nil
 372            str
 373          ;; Start with smallest substring candidate, ie. length 1.
 374          ;; Then check all the others and see whether any of them starts
 375          ;; with the same substring.  While there is such another
 376          ;; element in the list, increase the length of the candidate.
 377          (while (not done)
 378            (if (> i maxlen)
 379                (setq done t)
 380              (setq candidate (substring str 0 i)
 381                    done (not (erc-unique-substring-1 candidate others))))
 382            (setq i (1+ i)))
 383          (if (and (= (length candidate) (1- maxlen))
 384                   (not erc-track-shorten-aggressively))
 385              str
 386            candidate))))
 387    strings))
 388
 389 (defun erc-unique-substring-1 (candidate others)
 390   "Return non-nil when any string in OTHERS starts with CANDIDATE."
 391   (let (result other (maxlen (length candidate)))
 392     (while (and others
 393                 (not result))
 394       (setq other (car others)
 395             others (cdr others))
 396       (when (and (>= (length other) maxlen)
 397                  (string= candidate (substring other 0 maxlen)))
 398         (setq result other)))
 399     result))
 400
 401 ;;; Test:
 402
 403 (erc-assert
 404  (and
 405   ;; verify examples from the doc strings
 406   (equal (let ((erc-track-shorten-aggressively nil))
 407            (erc-unique-channel-names
 408             '("#emacs" "#vi" "#electronica" "#folk")
 409             '("#emacs" "#vi")))
 410          '("#em" "#vi"))         ; emacs is different from electronica
 411   (equal (let ((erc-track-shorten-aggressively t))
 412            (erc-unique-channel-names
 413             '("#emacs" "#vi" "#electronica" "#folk")
 414             '("#emacs" "#vi")))
 415          '("#em" "#v"))                ; vi is shortened by one letter
 416   (equal (let ((erc-track-shorten-aggressively 'max))
 417            (erc-unique-channel-names
 418             '("#emacs" "#vi" "#electronica" "#folk")
 419             '("#emacs" "#vi")))
 420          '("#e" "#v"))  ; emacs need not be different from electronica
 421   (equal (let ((erc-track-shorten-aggressively nil))
 422            (erc-unique-channel-names
 423             '("#linux-de" "#linux-fr")
 424             '("#linux-de" "#linux-fr")))
 425          '("#linux-de" "#linux-fr")) ; shortening by one letter is too aggressive
 426   (equal (let ((erc-track-shorten-aggressively t))
 427            (erc-unique-channel-names
 428             '("#linux-de" "#linux-fr")
 429             '("#linux-de" "#linux-fr")))
 430          '("#linux-d" "#linux-f")); now we want to be aggressive
 431   ;; specific problems
 432   (equal (let ((erc-track-shorten-aggressively nil))
 433            (erc-unique-channel-names
 434             '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile"
 435               "#testgnome" "#gnu" "#fsbot" "#hurd" "#hurd-bunny"
 436               "#emacs")
 437             '("#hurd-bunny" "#hurd" "#sawfish" "#lisp")))
 438          '("#hurd-" "#hurd" "#s" "#l"))
 439   (equal (let ((erc-track-shorten-aggressively nil))
 440            (erc-unique-substrings
 441             '("#emacs" "#vi" "#electronica" "#folk")))
 442          '("#em" "#vi" "#el" "#f"))
 443   (equal (let ((erc-track-shorten-aggressively t))
 444            (erc-unique-substrings
 445             '("#emacs" "#vi" "#electronica" "#folk")))
 446          '("#em" "#v" "#el" "#f"))
 447   (equal (let ((erc-track-shorten-aggressively nil))
 448            (erc-unique-channel-names
 449             '("#emacs" "#burse" "+linux.de" "#starwars"
 450               "#bitlbee" "+burse" "#ratpoison")
 451             '("+linux.de" "#starwars" "#burse")))
 452          '("+l" "#s" "#bu"))
 453   (equal (let ((erc-track-shorten-aggressively nil))
 454            (erc-unique-channel-names
 455             '("fsbot" "#emacs" "deego")
 456             '("fsbot")))
 457          '("fs"))
 458   (equal (let ((erc-track-shorten-aggressively nil))
 459            (erc-unique-channel-names
 460             '("fsbot" "#emacs" "deego")
 461             '("fsbot")
 462             (lambda (s)
 463               (> (length s) 4))
 464             1))
 465          '("f"))
 466   (equal (let ((erc-track-shorten-aggressively nil))
 467            (erc-unique-channel-names
 468             '("fsbot" "#emacs" "deego")
 469             '("fsbot")
 470             (lambda (s)
 471               (> (length s) 4))
 472             2))
 473          '("fs"))
 474   (let ((erc-track-shorten-aggressively nil))
 475     (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs")
 476                                      '("#hurd" "#hurd-bunny"))
 477            '("#hurd" "#hurd-")))
 478   ;; general examples
 479   (let ((erc-track-shorten-aggressively t))
 480     (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
 481          (not (erc-unique-substring-1 "a" '("xyz" "xab")))
 482          (equal (erc-unique-substrings '("abc" "xyz" "xab"))
 483                 '("ab" "xy" "xa"))
 484          (equal (erc-unique-substrings '("abc" "abcdefg"))
 485                 '("abc" "abcd"))))
 486   (let ((erc-track-shorten-aggressively nil))
 487     (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
 488          (not (erc-unique-substring-1 "a" '("xyz" "xab")))
 489          (equal (erc-unique-substrings '("abc" "xyz" "xab"))
 490                 '("abc" "xyz" "xab"))
 491          (equal (erc-unique-substrings '("abc" "abcdefg"))
 492                 '("abc" "abcd"))))))
 493
 494 ;;; Module
 495
 496 ;;;###autoload (autoload 'erc-track-mode "erc-track" nil t)
 497 (define-erc-module track track-modified-channels
 498   "This mode tracks ERC channel buffers with activity."
 499   ((erc-track-add-to-mode-line erc-track-position-in-mode-line)
 500    (setq erc-modified-channels-object (erc-modified-channels-object nil))
 501    (erc-update-mode-line)
 502    (if (featurep 'xemacs)
 503        (defadvice switch-to-buffer (after erc-update (&rest args) activate)
 504          (erc-modified-channels-update))
 505      (add-hook 'window-configuration-change-hook 'erc-modified-channels-update))
 506    (add-hook 'erc-insert-post-hook 'erc-track-modified-channels)
 507    (add-hook 'erc-disconnected-hook 'erc-modified-channels-update))
 508   ((erc-track-remove-from-mode-line)
 509    (if (featurep 'xemacs)
 510        (ad-disable-advice 'switch-to-buffer 'after 'erc-update)
 511      (remove-hook 'window-configuration-change-hook
 512                   'erc-modified-channels-update))
 513    (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
 514    (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)))
 515
 516 ;;;###autoload (autoload 'erc-track-when-inactive-mode "erc-track" nil t)
 517 (define-erc-module track-when-inactive nil
 518   "This mode enables channel tracking even for visible buffers,
 519 if you are inactivity."
 520   ((if (featurep 'xemacs)
 521        (defadvice switch-to-buffer (after erc-update-when-inactive (&rest args) activate)
 522          (erc-user-is-active))
 523      (add-hook 'window-configuration-change-hook 'erc-user-is-active))
 524    (add-hook 'erc-send-completed-hook 'erc-user-is-active)
 525    (add-hook 'erc-server-001-functions 'erc-user-is-active))
 526   ((erc-track-remove-from-mode-line)
 527    (if (featurep 'xemacs)
 528        (ad-disable-advice 'switch-to-buffer 'after 'erc-update-when-inactive)
 529      (remove-hook 'window-configuration-change-hook 'erc-user-is-active))
 530    (remove-hook 'erc-send-completed-hook 'erc-user-is-active)
 531    (remove-hook 'erc-server-001-functions 'erc-user-is-active)
 532    (remove-hook 'erc-timer-hook 'erc-user-is-active)))
 533
 534 ;;; Visibility
 535
 536 (defvar erc-buffer-activity nil
 537   "Last time the user sent something.")
 538
 539 (defvar erc-buffer-activity-timeout 10
 540   "How many seconds of inactivity by the user
 541 to consider when `erc-track-visibility' is set to
 542 only consider active buffers visible.")
 543
 544 (defun erc-user-is-active (&rest ignore)
 545   "Set `erc-buffer-activity'."
 546   (setq erc-buffer-activity (erc-current-time))
 547   (erc-track-modified-channels))
 548
 549 (defun erc-buffer-visible (buffer)
 550   "Return non-nil when the buffer is visible."
 551   (if erc-track-when-inactive-mode
 552       (when erc-buffer-activity; could be nil
 553         (and (get-buffer-window buffer erc-track-visibility)
 554              (<= (erc-time-diff erc-buffer-activity (erc-current-time))
 555                  erc-buffer-activity-timeout)))
 556     (get-buffer-window buffer erc-track-visibility)))
 557
 558 ;;; Tracking the channel modifications
 559
 560 (defvar erc-modified-channels-update-inside nil
 561   "Variable to prevent running `erc-modified-channels-update' multiple
 562 times.  Without it, you cannot debug `erc-modified-channels-display',
 563 because the debugger also cases changes to the window-configuration.")
 564
 565 (defun erc-modified-channels-update (&rest args)
 566   "This function updates the information in `erc-modified-channels-alist'
 567 according to buffer visibility.  It calls
 568 `erc-modified-channels-display' at the end. This should usually be
 569 called via `window-configuration-change-hook'.
 570 ARGS are ignored."
 571   (interactive)
 572   (unless erc-modified-channels-update-inside
 573     (let ((erc-modified-channels-update-inside t))
 574       (mapcar (lambda (elt)
 575                 (let ((buffer (car elt)))
 576                   (when (or (not (bufferp buffer))
 577                             (not (buffer-live-p buffer))
 578                             (erc-buffer-visible buffer)
 579                             (not (with-current-buffer buffer
 580                                    erc-server-connected)))
 581                     (erc-modified-channels-remove-buffer buffer))))
 582               erc-modified-channels-alist)
 583       (erc-modified-channels-display)
 584       (force-mode-line-update t))))
 585
 586 (defun erc-make-mode-line-buffer-name (string buffer &optional faces count)
 587   "Return STRING as a button that switches to BUFFER when clicked.
 588 If FACES are provided, color STRING with them."
 589   ;; We define a new sparse keymap every time, because 1. this data
 590   ;; structure is very small, the alternative would require us to
 591   ;; defvar a keymap, 2. the user is not interested in customizing it
 592   ;; (really?), 3. the defun needs to switch to BUFFER, so we would
 593   ;; need to save that value somewhere.
 594   (let ((map (make-sparse-keymap))
 595         (name (if erc-track-showcount
 596                   (concat string
 597                           erc-track-showcount-string
 598                           (int-to-string count))
 599                 (copy-sequence string))))
 600     (define-key map (vector 'mode-line 'mouse-2)
 601       `(lambda (e)
 602          (interactive "e")
 603          (save-selected-window
 604            (select-window
 605             (posn-window (event-start e)))
 606            (switch-to-buffer ,buffer))))
 607     (define-key map (vector 'mode-line 'mouse-3)
 608       `(lambda (e)
 609          (interactive "e")
 610          (save-selected-window
 611            (select-window
 612             (posn-window (event-start e)))
 613            (switch-to-buffer-other-window ,buffer))))
 614     (put-text-property 0 (length name) 'local-map map name)
 615     (when (and faces erc-track-use-faces)
 616       (put-text-property 0 (length name) 'face faces name))
 617     name))
 618
 619 (defun erc-modified-channels-display ()
 620   "Set `erc-modified-channels-object'
 621 according to `erc-modified-channels-alist'.
 622 Use `erc-make-mode-line-buffer-name' to create buttons."
 623   (if (or
 624         (eq 'mostactive erc-track-switch-direction)
 625         (eq 'leastactive erc-track-switch-direction))
 626       (erc-track-sort-by-activest))
 627   (if (null erc-modified-channels-alist)
 628       (setq erc-modified-channels-object (erc-modified-channels-object nil))
 629     ;; erc-modified-channels-alist contains all the data we need.  To
 630     ;; better understand what is going on, we split things up into
 631     ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES.  These
 632     ;; four lists we use to create a new
 633     ;; `erc-modified-channels-object' using
 634     ;; `erc-make-mode-line-buffer-name'.
 635     (let* ((buffers (mapcar 'car erc-modified-channels-alist))
 636            (counts (mapcar 'cadr erc-modified-channels-alist))
 637            (faces (mapcar 'cddr erc-modified-channels-alist))
 638            (long-names (mapcar #'(lambda (buf)
 639                                    (or (buffer-name buf)
 640                                        ""))
 641                                buffers))
 642            (short-names (if (functionp erc-track-shorten-function)
 643                             (funcall erc-track-shorten-function
 644                                      long-names)
 645                           long-names))
 646            strings)
 647       (while buffers
 648         (when (car short-names)
 649           (setq strings (cons (erc-make-mode-line-buffer-name
 650                                (car short-names)
 651                                (car buffers)
 652                                (car faces)
 653                                (car counts))
 654                               strings)))
 655         (setq short-names (cdr short-names)
 656               buffers (cdr buffers)
 657               counts (cdr counts)
 658               faces (cdr faces)))
 659       (when (featurep 'xemacs)
 660         (erc-modified-channels-object nil))
 661       (setq erc-modified-channels-object
 662             (erc-modified-channels-object strings)))))
 663
 664 (defun erc-modified-channels-remove-buffer (buffer)
 665   "Remove BUFFER from `erc-modified-channels-alist'."
 666   (interactive "bBuffer: ")
 667   (setq erc-modified-channels-alist
 668         (delete (assq buffer erc-modified-channels-alist)
 669                 erc-modified-channels-alist))
 670   (when (interactive-p)
 671     (erc-modified-channels-display)))
 672
 673 (defun erc-track-find-face (faces)
 674   "Return the face to use in the modeline from the faces in FACES.
 675 If `erc-track-faces-priority-list' is set, the one from FACES who is
 676 first in that list will be used."
 677   (let ((candidates erc-track-faces-priority-list)
 678         candidate face)
 679     (while (and candidates (not face))
 680       (setq candidate (car candidates)
 681             candidates (cdr candidates))
 682       (when (memq candidate faces)
 683         (setq face candidate)))
 684     face))
 685
 686 (defun erc-track-modified-channels ()
 687   "Hook function for `erc-insert-post-hook' to check if the current
 688 buffer should be added to the modeline as a hidden, modified
 689 channel.  Assumes it will only be called when current-buffer
 690 is in `erc-mode'."
 691   (let ((this-channel (or (erc-default-target)
 692                           (buffer-name (current-buffer)))))
 693     (if (and (not (erc-buffer-visible (current-buffer)))
 694              (not (member this-channel erc-track-exclude))
 695              (not (and erc-track-exclude-server-buffer
 696                        (string= this-channel
 697                                 (buffer-name (erc-server-buffer)))))
 698              (not (erc-message-type-member
 699                    (or (erc-find-parsed-property)
 700                        (point-min))
 701                    erc-track-exclude-types)))
 702         ;; If the active buffer is not visible (not shown in a
 703         ;; window), and not to be excluded, determine the kinds of
 704         ;; faces used in the current message, and unless the user
 705         ;; wants to ignore changes in certain channels where there
 706         ;; are no faces corresponding to `erc-track-faces-priority-list',
 707         ;; and the faces in the current message are found in said
 708         ;; priority list, add the buffer to the erc-modified-channels-alist,
 709         ;; if it is not already there.  If the buffer is already on the list
 710         ;; (in the car), change its face attribute (in the cddr) if
 711         ;; necessary.  See `erc-modified-channels-alist' for the
 712         ;; exact data structure used.
 713         (let ((faces (erc-faces-in (buffer-string))))
 714           (unless (and
 715                    (or (eq erc-track-priority-faces-only 'all)
 716                        (member this-channel erc-track-priority-faces-only))
 717                    (not (catch 'found
 718                           (dolist (f faces)
 719                             (when (member f erc-track-faces-priority-list)
 720                               (throw 'found t))))))
 721             (if (not (assq (current-buffer) erc-modified-channels-alist))
 722                 ;; Add buffer, faces and counts
 723                 (setq erc-modified-channels-alist
 724                       (cons (cons (current-buffer)
 725                                   (cons 1 (erc-track-find-face faces)))
 726                             erc-modified-channels-alist))
 727               ;; Else modify the face for the buffer, if necessary.
 728               (when faces
 729                 (let* ((cell (assq (current-buffer)
 730                                    erc-modified-channels-alist))
 731                        (old-face (cddr cell))
 732                        (new-face (erc-track-find-face
 733                                   (if old-face
 734                                       (cons old-face faces)
 735                                     faces))))
 736                   (setcdr cell (cons (1+ (cadr cell)) new-face)))))
 737             ;; And display it
 738             (erc-modified-channels-display)))
 739       ;; Else if the active buffer is the current buffer, remove it
 740       ;; from our list.
 741       (when (or (erc-buffer-visible (current-buffer))
 742                 (and this-channel
 743                      (assq (current-buffer) erc-modified-channels-alist)
 744                      (member this-channel erc-track-exclude)))
 745         ;; Remove it from mode-line if buffer is visible or
 746         ;; channel was added to erc-track-exclude recently.
 747         (erc-modified-channels-remove-buffer (current-buffer))
 748         (erc-modified-channels-display)))))
 749
 750 (defun erc-faces-in (str)
 751   "Return a list of all faces used in STR."
 752   (let ((i 0)
 753         (m (length str))
 754         (faces (erc-list (get-text-property 0 'face str))))
 755     (while (and (setq i (next-single-property-change i 'face str m))
 756                 (not (= i m)))
 757       (dolist (face (erc-list (get-text-property i 'face str)))
 758         (add-to-list 'faces face)))
 759     faces))
 760
 761 (erc-assert
 762  (let ((str "is bold"))
 763    (put-text-property 3 (length str)
 764                       'face '(bold erc-current-nick-face)
 765                       str)
 766    (erc-faces-in str)))
 767
 768 (defun erc-find-parsed-property ()
 769   "Find the next occurrence of the `erc-parsed' text property."
 770   (text-property-not-all (point-min) (point-max) 'erc-parsed nil))
 771
 772 ;;; Buffer switching
 773
 774 (defvar erc-track-last-non-erc-buffer nil
 775   "Stores the name of the last buffer you were in before activating
 776 `erc-track-switch-buffers'")
 777
 778 (defun erc-track-sort-by-activest ()
 779   "Sort erc-modified-channels-alist by activity.
 780 That means the number of unseen messages in a channel."
 781   (setq erc-modified-channels-alist
 782         (sort erc-modified-channels-alist
 783               (lambda (a b) (> (nth 1 a) (nth 1 b))))))
 784
 785 (defun erc-track-get-active-buffer (arg)
 786   "Return the buffer name of ARG in `erc-modified-channels-alist'.
 787 Negative arguments index in the opposite direction.  This direction is
 788 relative to `erc-track-switch-direction'"
 789   (let ((dir erc-track-switch-direction)
 790         offset)
 791     (when (< arg 0)
 792       (setq dir (case dir
 793                   (oldest      'newest)
 794                   (newest      'oldest)
 795                   (mostactive  'leastactive)
 796                   (leastactive 'mostactive)))
 797       (setq arg (- arg)))
 798     (setq offset (case dir
 799                    ((oldest leastactive)
 800                     (- (length erc-modified-channels-alist) arg))
 801                    (t (1- arg))))
 802     ;; normalise out of range user input
 803     (cond ((>= offset (length erc-modified-channels-alist))
 804            (setq offset (1- (length erc-modified-channels-alist))))
 805           ((< offset 0)
 806            (setq offset 0)))
 807     (car (nth offset erc-modified-channels-alist))))
 808
 809 (defun erc-track-switch-buffer (arg)
 810   "Switch to the next active ERC buffer, or if there are no active buffers,
 811 switch back to the last non-ERC buffer visited.  Next is defined by
 812 `erc-track-switch-direction', a negative argument will reverse this."
 813   (interactive "p")
 814   (when erc-track-mode
 815     (cond (erc-modified-channels-alist
 816            ;; if we're not in erc-mode, set this buffer to return to
 817            (unless (eq major-mode 'erc-mode)
 818              (setq erc-track-last-non-erc-buffer (current-buffer)))
 819            ;; and jump to the next active channel
 820            (switch-to-buffer (erc-track-get-active-buffer arg)))
 821           ;; if no active channels, switch back to what we were doing before
 822           ((and erc-track-last-non-erc-buffer
 823                 erc-track-switch-from-erc
 824                 (buffer-live-p erc-track-last-non-erc-buffer))
 825            (switch-to-buffer erc-track-last-non-erc-buffer)))))
 826
 827 ;; These bindings are global, because they pop us from any other
 828 ;; buffer to an active ERC buffer!
 829
 830 (global-set-key (kbd "C-c C-@") 'erc-track-switch-buffer)
 831 (global-set-key (kbd "C-c C-SPC") 'erc-track-switch-buffer)
 832
 833 (provide 'erc-track)
 834
 835 ;;; erc-track.el ends here
 836 ;;
 837 ;; Local Variables:
 838 ;; indent-tabs-mode: t
 839 ;; tab-width: 8
 840 ;; End:
 841
 842 ;; arch-tag: 11b439f5-e5d7-4c6c-bb3f-eda98f9b0ac1