lisp/erc/erc-track.el

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