lisp/erc/erc-track.el

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