lisp/erc/erc-track.el

   1 ;;; erc-track.el --- Track modified channel buffers
   2
   3 ;; Copyright (C) 2002-2011 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 was active"
  88                          active)))
  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   "Global minor mode for tracking ERC buffers and showing activity in the
 592 mode line.
 593
 594 This exists for the sole purpose of providing the C-c C-SPC and
 595 C-c C-@ keybindings.  Make sure that you have enabled the track
 596 module, otherwise the keybindings will not do anything useful."
 597   :init-value nil
 598   :lighter ""
 599   :keymap erc-track-minor-mode-map
 600   :global t
 601   :group 'erc-track)
 602
 603 (defun erc-track-minor-mode-maybe (&optional buffer)
 604   "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'."
 605   (when (and (not erc-track-minor-mode)
 606              ;; don't start the minor mode until we have an ERC
 607              ;; process running, because we don't want to prompt the
 608              ;; user while starting Emacs
 609              (or (and (buffer-live-p buffer)
 610                       (with-current-buffer buffer (eq major-mode 'erc-mode)))
 611                  (erc-buffer-list)))
 612     (cond ((eq erc-track-enable-keybindings 'ask)
 613            (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC")
 614                           (and (key-binding (kbd "C-c C-@")) "C-@"))))
 615              (if key
 616                  (if (y-or-n-p
 617                       (concat "The C-c " key " binding is in use;"
 618                               " override it for tracking? "))
 619                      (progn
 620                        (message (concat "Will change it; set"
 621                                         " `erc-track-enable-keybindings'"
 622                                         " to disable this message"))
 623                        (sleep-for 3)
 624                        (erc-track-minor-mode 1))
 625                    (message (concat "Not changing it; set"
 626                                     " `erc-track-enable-keybindings'"
 627                                     " to disable this message"))
 628                    (sleep-for 3))
 629                (erc-track-minor-mode 1))))
 630           ((eq erc-track-enable-keybindings t)
 631            (erc-track-minor-mode 1))
 632           (t nil))))
 633
 634 ;;; Module
 635
 636 ;;;###autoload (autoload 'erc-track-mode "erc-track" nil t)
 637 (define-erc-module track nil
 638   "This mode tracks ERC channel buffers with activity."
 639   ;; Enable:
 640   ((when (boundp 'erc-track-when-inactive)
 641      (if erc-track-when-inactive
 642          (progn
 643            (if (featurep 'xemacs)
 644                (defadvice switch-to-buffer (after erc-update-when-inactive
 645                                                   (&rest args) activate)
 646                  (erc-user-is-active))
 647              (add-hook 'window-configuration-change-hook 'erc-user-is-active))
 648            (add-hook 'erc-send-completed-hook 'erc-user-is-active)
 649            (add-hook 'erc-server-001-functions 'erc-user-is-active))
 650        (erc-track-add-to-mode-line erc-track-position-in-mode-line)
 651        (erc-update-mode-line)
 652        (if (featurep 'xemacs)
 653            (defadvice switch-to-buffer (after erc-update (&rest args) activate)
 654              (erc-modified-channels-update))
 655          (add-hook 'window-configuration-change-hook
 656                    'erc-window-configuration-change))
 657        (add-hook 'erc-insert-post-hook 'erc-track-modified-channels)
 658        (add-hook 'erc-disconnected-hook 'erc-modified-channels-update))
 659      ;; enable the tracking keybindings
 660      (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
 661      (erc-track-minor-mode-maybe)))
 662   ;; Disable:
 663   ((when (boundp 'erc-track-when-inactive)
 664      (erc-track-remove-from-mode-line)
 665      (if erc-track-when-inactive
 666          (progn
 667            (if (featurep 'xemacs)
 668                (ad-disable-advice 'switch-to-buffer 'after
 669                                   'erc-update-when-inactive)
 670              (remove-hook 'window-configuration-change-hook
 671                           'erc-user-is-active))
 672            (remove-hook 'erc-send-completed-hook 'erc-user-is-active)
 673            (remove-hook 'erc-server-001-functions 'erc-user-is-active)
 674            (remove-hook 'erc-timer-hook 'erc-user-is-active))
 675        (if (featurep 'xemacs)
 676            (ad-disable-advice 'switch-to-buffer 'after 'erc-update)
 677          (remove-hook 'window-configuration-change-hook
 678                       'erc-window-configuration-change))
 679        (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
 680        (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels))
 681      ;; disable the tracking keybindings
 682      (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
 683      (when erc-track-minor-mode
 684        (erc-track-minor-mode -1)))))
 685
 686 (defcustom erc-track-when-inactive nil
 687   "Enable channel tracking even for visible buffers, if you are
 688 inactive."
 689   :group 'erc-track
 690   :type 'boolean
 691   :set (lambda (sym val)
 692          (if erc-track-mode
 693              (progn
 694                (erc-track-disable)
 695                (set sym val)
 696                (erc-track-enable))
 697            (set sym val))))
 698
 699 ;;; Visibility
 700
 701 (defvar erc-buffer-activity nil
 702   "Last time the user sent something.")
 703
 704 (defvar erc-buffer-activity-timeout 10
 705   "How many seconds of inactivity by the user
 706 to consider when `erc-track-visibility' is set to
 707 only consider active buffers visible.")
 708
 709 (defun erc-user-is-active (&rest ignore)
 710   "Set `erc-buffer-activity'."
 711   (when erc-server-connected
 712     (setq erc-buffer-activity (erc-current-time))
 713     (erc-track-modified-channels)))
 714
 715 (defun erc-track-get-buffer-window (buffer frame-param)
 716   (if (eq frame-param 'selected-visible)
 717       (if (eq (frame-visible-p (selected-frame)) t)
 718           (get-buffer-window buffer nil)
 719         nil)
 720     (get-buffer-window buffer frame-param)))
 721
 722 (defun erc-buffer-visible (buffer)
 723   "Return non-nil when the buffer is visible."
 724   (if erc-track-when-inactive
 725       (when erc-buffer-activity; could be nil
 726         (and (erc-track-get-buffer-window buffer erc-track-visibility)
 727              (<= (erc-time-diff erc-buffer-activity (erc-current-time))
 728                  erc-buffer-activity-timeout)))
 729     (erc-track-get-buffer-window buffer erc-track-visibility)))
 730
 731 ;;; Tracking the channel modifications
 732
 733 (defun erc-window-configuration-change ()
 734   (unless (minibuffer-window-active-p (minibuffer-window))
 735     ;; delay this until command has finished to make sure window is
 736     ;; actually visible before clearing activity
 737     (add-hook 'post-command-hook 'erc-modified-channels-update)))
 738
 739 (defvar erc-modified-channels-update-inside nil
 740   "Variable to prevent running `erc-modified-channels-update' multiple
 741 times.  Without it, you cannot debug `erc-modified-channels-display',
 742 because the debugger also cases changes to the window-configuration.")
 743
 744 (defun erc-modified-channels-update (&rest args)
 745   "This function updates the information in `erc-modified-channels-alist'
 746 according to buffer visibility.  It calls
 747 `erc-modified-channels-display' at the end. This should usually be
 748 called via `window-configuration-change-hook'.
 749 ARGS are ignored."
 750   (interactive)
 751   (unless erc-modified-channels-update-inside
 752     (let ((erc-modified-channels-update-inside t)
 753           (removed-channel nil))
 754       (mapc (lambda (elt)
 755               (let ((buffer (car elt)))
 756                 (when (or (not (bufferp buffer))
 757                           (not (buffer-live-p buffer))
 758                           (erc-buffer-visible buffer)
 759                           (and erc-track-remove-disconnected-buffers
 760                                (not (with-current-buffer buffer
 761                                       erc-server-connected))))
 762                   (setq removed-channel t)
 763                   (erc-modified-channels-remove-buffer buffer))))
 764             erc-modified-channels-alist)
 765       (when removed-channel
 766         (erc-modified-channels-display)
 767         (force-mode-line-update t)))
 768     (remove-hook 'post-command-hook 'erc-modified-channels-update)))
 769
 770 (defvar erc-track-mouse-face (if (featurep 'xemacs)
 771                                  'modeline-mousable
 772                                'mode-line-highlight)
 773   "The face to use when mouse is over channel names in the mode line.")
 774
 775 (defun erc-make-mode-line-buffer-name (string buffer &optional faces count)
 776   "Return STRING as a button that switches to BUFFER when clicked.
 777 If FACES are provided, color STRING with them."
 778   ;; We define a new sparse keymap every time, because 1. this data
 779   ;; structure is very small, the alternative would require us to
 780   ;; defvar a keymap, 2. the user is not interested in customizing it
 781   ;; (really?), 3. the defun needs to switch to BUFFER, so we would
 782   ;; need to save that value somewhere.
 783   (let ((map (make-sparse-keymap))
 784         (name (if erc-track-showcount
 785                   (concat string
 786                           erc-track-showcount-string
 787                           (int-to-string count))
 788                 (copy-sequence string))))
 789     (define-key map (vector 'mode-line 'mouse-2)
 790       `(lambda (e)
 791          (interactive "e")
 792          (save-selected-window
 793            (select-window
 794             (posn-window (event-start e)))
 795            (switch-to-buffer ,buffer))))
 796     (define-key map (vector 'mode-line 'mouse-3)
 797       `(lambda (e)
 798          (interactive "e")
 799          (save-selected-window
 800            (select-window
 801             (posn-window (event-start e)))
 802            (switch-to-buffer-other-window ,buffer))))
 803     (put-text-property 0 (length name) 'local-map map name)
 804     (put-text-property
 805      0 (length name)
 806      'help-echo (concat "mouse-2: switch to buffer, "
 807                         "mouse-3: switch to buffer in other window")
 808      name)
 809     (put-text-property 0 (length name) 'mouse-face erc-track-mouse-face name)
 810     (when (and faces erc-track-use-faces)
 811       (put-text-property 0 (length name) 'face faces name))
 812     name))
 813
 814 (defun erc-modified-channels-display ()
 815   "Set `erc-modified-channels-object'
 816 according to `erc-modified-channels-alist'.
 817 Use `erc-make-mode-line-buffer-name' to create buttons."
 818   (cond ((or (eq 'mostactive erc-track-switch-direction)
 819              (eq 'leastactive erc-track-switch-direction))
 820          (erc-track-sort-by-activest))
 821         ((eq 'importance erc-track-switch-direction)
 822          (erc-track-sort-by-importance)))
 823   (run-hooks 'erc-track-list-changed-hook)
 824   (unless (eq erc-track-position-in-mode-line nil)
 825   (if (null erc-modified-channels-alist)
 826       (setq erc-modified-channels-object (erc-modified-channels-object nil))
 827     ;; erc-modified-channels-alist contains all the data we need.  To
 828     ;; better understand what is going on, we split things up into
 829     ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES.  These
 830     ;; four lists we use to create a new
 831     ;; `erc-modified-channels-object' using
 832     ;; `erc-make-mode-line-buffer-name'.
 833     (let* ((buffers (mapcar 'car erc-modified-channels-alist))
 834            (counts (mapcar 'cadr erc-modified-channels-alist))
 835            (faces (mapcar 'cddr erc-modified-channels-alist))
 836            (long-names (mapcar #'(lambda (buf)
 837                                    (or (buffer-name buf)
 838                                        ""))
 839                                buffers))
 840            (short-names (if (functionp erc-track-shorten-function)
 841                             (funcall erc-track-shorten-function
 842                                      long-names)
 843                           long-names))
 844            strings)
 845       (while buffers
 846         (when (car short-names)
 847           (setq strings (cons (erc-make-mode-line-buffer-name
 848                                (car short-names)
 849                                (car buffers)
 850                                (car faces)
 851                                (car counts))
 852                               strings)))
 853         (setq short-names (cdr short-names)
 854               buffers (cdr buffers)
 855               counts (cdr counts)
 856               faces (cdr faces)))
 857       (when (featurep 'xemacs)
 858         (erc-modified-channels-object nil))
 859       (setq erc-modified-channels-object
 860             (erc-modified-channels-object strings))))))
 861
 862 (defun erc-modified-channels-remove-buffer (buffer)
 863   "Remove BUFFER from `erc-modified-channels-alist'."
 864   (interactive "bBuffer: ")
 865   (setq erc-modified-channels-alist
 866         (delete (assq buffer erc-modified-channels-alist)
 867                 erc-modified-channels-alist))
 868   (when (interactive-p)
 869     (erc-modified-channels-display)))
 870
 871 (defun erc-track-find-face (faces)
 872   "Return the face to use in the modeline from the faces in FACES.
 873 If `erc-track-faces-priority-list' is set, the one from FACES who
 874 is first in that list will be used.  If nothing matches or if
 875 `erc-track-faces-priority-list' is not set, the default mode-line
 876 faces will be used.
 877
 878 If `erc-track-faces-normal-list' is non-nil, use it to produce a
 879 blinking effect that indicates channel activity when the first
 880 element in FACES and the highest-ranking face among the rest of
 881 FACES are both members of `erc-track-faces-normal-list'.
 882
 883 If one of the faces is a list, then it will be ranked according
 884 to its highest-tanking face member.  A list of faces including
 885 that member will take priority over just the single member
 886 element."
 887   (let ((choice (catch 'face
 888                   (dolist (candidate erc-track-faces-priority-list)
 889                     (when (member candidate faces)
 890                       (throw 'face candidate)))))
 891         (no-first (and erc-track-faces-normal-list
 892                        (catch 'face
 893                          (dolist (candidate erc-track-faces-priority-list)
 894                            (when (member candidate (cdr faces))
 895                              (throw 'face candidate)))))))
 896     (cond ((null choice)
 897            nil)
 898           ((and (member choice erc-track-faces-normal-list)
 899                 (member no-first erc-track-faces-normal-list))
 900            no-first)
 901           (t
 902            choice))))
 903
 904 (defun erc-track-modified-channels ()
 905   "Hook function for `erc-insert-post-hook' to check if the current
 906 buffer should be added to the modeline as a hidden, modified
 907 channel.  Assumes it will only be called when current-buffer
 908 is in `erc-mode'."
 909   (let ((this-channel (or (erc-default-target)
 910                           (buffer-name (current-buffer)))))
 911     (if (and (not (erc-buffer-visible (current-buffer)))
 912              (not (member this-channel erc-track-exclude))
 913              (not (and erc-track-exclude-server-buffer
 914                        (erc-server-buffer-p)))
 915              (not (erc-message-type-member
 916                    (or (erc-find-parsed-property)
 917                        (point-min))
 918                    erc-track-exclude-types)))
 919         ;; If the active buffer is not visible (not shown in a
 920         ;; window), and not to be excluded, determine the kinds of
 921         ;; faces used in the current message, and unless the user
 922         ;; wants to ignore changes in certain channels where there
 923         ;; are no faces corresponding to `erc-track-faces-priority-list',
 924         ;; and the faces in the current message are found in said
 925         ;; priority list, add the buffer to the erc-modified-channels-alist,
 926         ;; if it is not already there.  If the buffer is already on the list
 927         ;; (in the car), change its face attribute (in the cddr) if
 928         ;; necessary.  See `erc-modified-channels-alist' for the
 929         ;; exact data structure used.
 930         (let ((faces (erc-faces-in (buffer-string))))
 931           (unless (and
 932                    (or (eq erc-track-priority-faces-only 'all)
 933                        (member this-channel erc-track-priority-faces-only))
 934                    (not (catch 'found
 935                           (dolist (f faces)
 936                             (when (member f erc-track-faces-priority-list)
 937                               (throw 'found t))))))
 938             (if (not (assq (current-buffer) erc-modified-channels-alist))
 939                 ;; Add buffer, faces and counts
 940                 (setq erc-modified-channels-alist
 941                       (cons (cons (current-buffer)
 942                                   (cons 1 (erc-track-find-face faces)))
 943                             erc-modified-channels-alist))
 944               ;; Else modify the face for the buffer, if necessary.
 945               (when faces
 946                 (let* ((cell (assq (current-buffer)
 947                                    erc-modified-channels-alist))
 948                        (old-face (cddr cell))
 949                        (new-face (erc-track-find-face
 950                                   (if old-face
 951                                       (cons old-face faces)
 952                                     faces))))
 953                   (setcdr cell (cons (1+ (cadr cell)) new-face)))))
 954             ;; And display it
 955             (erc-modified-channels-display)))
 956       ;; Else if the active buffer is the current buffer, remove it
 957       ;; from our list.
 958       (when (and (or (erc-buffer-visible (current-buffer))
 959                 (and this-channel
 960                      (member this-channel erc-track-exclude)))
 961                  (assq (current-buffer) erc-modified-channels-alist))
 962         ;; Remove it from mode-line if buffer is visible or
 963         ;; channel was added to erc-track-exclude recently.
 964         (erc-modified-channels-remove-buffer (current-buffer))
 965         (erc-modified-channels-display)))))
 966
 967 (defun erc-faces-in (str)
 968   "Return a list of all faces used in STR."
 969   (let ((i 0)
 970         (m (length str))
 971         (faces (erc-list (get-text-property 0 'face str)))
 972         cur)
 973     (while (and (setq i (next-single-property-change i 'face str m))
 974                 (not (= i m)))
 975       (when (setq cur (get-text-property i 'face str))
 976         (add-to-list 'faces cur)))
 977     faces))
 978
 979 (assert
 980  (let ((str "is bold"))
 981    (put-text-property 3 (length str)
 982                       'face '(bold erc-current-nick-face)
 983                       str)
 984    (erc-faces-in str)))
 985
 986 ;;; Buffer switching
 987
 988 (defvar erc-track-last-non-erc-buffer nil
 989   "Stores the name of the last buffer you were in before activating
 990 `erc-track-switch-buffers'")
 991
 992 (defun erc-track-sort-by-activest ()
 993   "Sort erc-modified-channels-alist by activity.
 994 That means the number of unseen messages in a channel."
 995   (setq erc-modified-channels-alist
 996         (sort erc-modified-channels-alist
 997               (lambda (a b) (> (nth 1 a) (nth 1 b))))))
 998
 999 (defun erc-track-face-priority (face)
1000   "Return a number indicating the priority of FACE in
1001 `erc-track-faces-priority-list'.  Lower number means higher
1002 priority.
1003
1004 If face is not in `erc-track-faces-priority-list', it will have a
1005 higher number than any other face in that list."
1006   (let ((count 0))
1007     (catch 'done
1008       (dolist (item erc-track-faces-priority-list)
1009         (if (equal item face)
1010             (throw 'done t)
1011           (setq count (1+ count)))))
1012     count))
1013
1014 (defun erc-track-sort-by-importance ()
1015   "Sort erc-modified-channels-alist by importance.
1016 That means the position of the face in `erc-track-faces-priority-list'."
1017   (setq erc-modified-channels-alist
1018         (sort erc-modified-channels-alist
1019               (lambda (a b) (< (erc-track-face-priority (cddr a))
1020                                (erc-track-face-priority (cddr b)))))))
1021
1022 (defun erc-track-get-active-buffer (arg)
1023   "Return the buffer name of ARG in `erc-modified-channels-alist'.
1024 Negative arguments index in the opposite direction.  This direction is
1025 relative to `erc-track-switch-direction'"
1026   (let ((dir erc-track-switch-direction)
1027         offset)
1028     (when (< arg 0)
1029       (setq dir (case dir
1030                   (oldest      'newest)
1031                   (newest      'oldest)
1032                   (mostactive  'leastactive)
1033                   (leastactive 'mostactive)
1034                   (importance  'oldest)))
1035       (setq arg (- arg)))
1036     (setq offset (case dir
1037                    ((oldest leastactive)
1038                     (- (length erc-modified-channels-alist) arg))
1039                    (t (1- arg))))
1040     ;; normalise out of range user input
1041     (cond ((>= offset (length erc-modified-channels-alist))
1042            (setq offset (1- (length erc-modified-channels-alist))))
1043           ((< offset 0)
1044            (setq offset 0)))
1045     (car (nth offset erc-modified-channels-alist))))
1046
1047 (defun erc-track-switch-buffer (arg)
1048   "Switch to the next active ERC buffer, or if there are no active buffers,
1049 switch back to the last non-ERC buffer visited.  Next is defined by
1050 `erc-track-switch-direction', a negative argument will reverse this."
1051   (interactive "p")
1052   (if (not erc-track-mode)
1053       (message (concat "Enable the ERC track module if you want to use the"
1054                        " tracking minor mode"))
1055     (cond (erc-modified-channels-alist
1056            ;; if we're not in erc-mode, set this buffer to return to
1057            (unless (eq major-mode 'erc-mode)
1058              (setq erc-track-last-non-erc-buffer (current-buffer)))
1059            ;; and jump to the next active channel
1060            (switch-to-buffer (erc-track-get-active-buffer arg)))
1061           ;; if no active channels, switch back to what we were doing before
1062           ((and erc-track-last-non-erc-buffer
1063                 erc-track-switch-from-erc
1064                 (buffer-live-p erc-track-last-non-erc-buffer))
1065            (switch-to-buffer erc-track-last-non-erc-buffer)))))
1066
1067 (provide 'erc-track)
1068
1069 ;;; erc-track.el ends here
1070 ;;
1071 ;; Local Variables:
1072 ;; indent-tabs-mode: t
1073 ;; tab-width: 8
1074 ;; End:
1075