jabber-activity.el

   1 ;;; jabber-activity.el --- show jabber activity in the mode line
   2
   3 ;; Copyright (C) 2004 Carl Henrik Lunde - <chlunde+jabber+@ping.uio.no>
   4
   5 ;; This file is a part of jabber.el
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 ;; Boston, MA 02111-1307, USA.
  21
  22 ;;; Commentary:
  23
  24 ;; Allows tracking messages from buddies using the global mode line
  25 ;; See (info "(jabber)Tracking activity")
  26
  27 ;;; TODO:
  28
  29 ;; - Make it possible to enable this mode using M-x customize
  30 ;; - When Emacs is on another desktop, (get-buffer-window buf 'visible)
  31 ;;   returns nil.  We need to know when the user selects the frame again
  32 ;;   so we can remove the string from the mode line.  (Or just run
  33 ;;   jabber-activity-clean often).
  34 ;; - jabber-activity-switch-to needs a keybinding.  In which map?
  35 ;; - Is there any need for having defcustom jabber-activity-make-string?
  36 ;; - When there's activity in a buffer it would be nice with a hook which
  37 ;;   does the opposite of bury-buffer, so switch-to-buffer will show that
  38 ;;   buffer first.
  39
  40 ;;; Code:
  41
  42 (require 'jabber-core)
  43 (require 'jabber-alert)
  44 (require 'jabber-util)
  45 (require 'jabber-autoloads)
  46 (require 'cl)
  47
  48 (defgroup jabber-activity nil
  49   "activity tracking options"
  50   :group 'jabber)
  51
  52 ;; All the (featurep 'jabber-activity) is so we don't call a function
  53 ;; with an autoloaded cookie while the file is loading, since that
  54 ;; would lead to endless load recursion.
  55
  56 (defcustom jabber-activity-make-string 'jabber-activity-make-string-default
  57   "Function to call, for making the string to put in the mode
  58 line.  The default function returns the nick of the user."
  59   :set #'(lambda (var val)
  60            (custom-set-default var val)
  61            (when (and (featurep 'jabber-activity)
  62                       (fboundp 'jabber-activity-make-name-alist))
  63              (jabber-activity-make-name-alist)
  64              (jabber-activity-mode-line-update)))
  65   :type 'function
  66   :group 'jabber-activity)
  67
  68 (defcustom jabber-activity-shorten-minimum 1
  69   "All strings returned by `jabber-activity-make-strings-shorten' will be
  70 at least this long, when possible."
  71   :group 'jabber-activity
  72   :type 'number)
  73
  74 (defcustom jabber-activity-make-strings 'jabber-activity-make-strings-default
  75   "Function which should return an alist of JID -> string when given a list of
  76 JIDs."
  77   :set #'(lambda (var val)
  78            (custom-set-default var val)
  79            (when (and (featurep 'jabber-activity)
  80                       (fboundp 'jabber-activity-make-name-alist))
  81              (jabber-activity-make-name-alist)
  82              (jabber-activity-mode-line-update)))
  83   :type '(choice (function-item :tag "Keep strings"
  84                                 :value jabber-activity-make-strings-default)
  85                  (function-item :tag "Shorten strings"
  86                                 :value jabber-activity-make-strings-shorten)
  87                  (function :tag "Other function"))
  88   :group 'jabber-activity)
  89
  90 (defcustom jabber-activity-count-in-title nil
  91   "If non-nil, display number of active JIDs in frame title."
  92   :type 'boolean
  93   :group 'jabber-activity
  94   :set #'(lambda (var val)
  95            (custom-set-default var val)
  96            (when (and (featurep 'jabber-activity)
  97                       (bound-and-true-p jabber-activity-mode))
  98              (jabber-activity-mode -1)
  99              (jabber-activity-mode 1))))
 100
 101 (defcustom jabber-activity-count-in-title-format
 102   '(jabber-activity-jids ("[" jabber-activity-count-string "] "))
 103   "Format string used for displaying activity in frame titles.
 104 Same syntax as `mode-line-format'."
 105   :type 'sexp
 106   :group 'jabber-activity
 107   :set #'(lambda (var val)
 108            (if (not (and (featurep 'jabber-activity) (bound-and-true-p jabber-activity-mode)))
 109                (custom-set-default var val)
 110              (jabber-activity-mode -1)
 111              (custom-set-default var val)
 112              (jabber-activity-mode 1))))
 113
 114 (defcustom jabber-activity-show-p 'jabber-activity-show-p-default
 115   "Predicate function to call to check if the given JID should be
 116 shown in the mode line or not."
 117   :type 'function
 118   :group 'jabber-activity)
 119
 120 (defcustom jabber-activity-query-unread t
 121   "Query the user as to whether killing Emacs should be cancelled when
 122 there are unread messages which otherwise would be lost."
 123   :type 'boolean
 124   :group 'jabber-activity)
 125
 126 (defcustom jabber-activity-banned nil
 127   "List of regexps of banned JID"
 128   :type '(repeat string)
 129   :group 'jabber-activity)
 130
 131 (defface jabber-activity-face
 132   '((t (:foreground "red" :weight bold)))
 133   "The face for displaying jabber-activity-string in the mode line"
 134   :group 'jabber-activity)
 135
 136 (defvar jabber-activity-jids nil
 137   "A list of JIDs which have caused activity")
 138
 139 (defvar jabber-activity-name-alist nil
 140   "Alist of mode line names for bare JIDs")
 141
 142 (defvar jabber-activity-mode-string ""
 143   "The mode string for jabber activity")
 144
 145 (defvar jabber-activity-count-string "0"
 146   "Number of active JIDs as a string.")
 147
 148 (defvar jabber-activity-update-hook nil
 149   "Hook called when `jabber-activity-jids' changes.
 150 It is called after `jabber-activity-mode-string' and
 151 `jabber-activity-count-string' are updated.")
 152
 153 ;; Protect this variable from being set in Local variables etc.
 154 (put 'jabber-activity-mode-string 'risky-local-variable t)
 155 (put 'jabber-activity-count-string 'risky-local-variable t)
 156
 157 (defun jabber-activity-make-string-default (jid)
 158   "Return the nick of the JID.  If no nick is available, return
 159 the user name part of the JID.  In private MUC conversations,
 160 return the user's nickname."
 161   (if (jabber-muc-sender-p jid)
 162       (jabber-jid-resource jid)
 163     (let ((nick (jabber-jid-displayname jid))
 164           (user (jabber-jid-user jid))
 165           (username (jabber-jid-username jid)))
 166       (if (and username (string= nick user))
 167           username
 168         nick))))
 169
 170 (defun jabber-activity-make-strings-default (jids)
 171   "Apply `jabber-activity-make-string' on JIDS"
 172   (mapcar #'(lambda (jid) (cons jid (funcall jabber-activity-make-string jid)))
 173           jids))
 174
 175 (defun jabber-activity-common-prefix (s1 s2)
 176   "Return length of common prefix string shared by S1 and S2"
 177   (let ((len (min (length s1) (length s2))))
 178     (or (dotimes (i len)
 179           (when (not (eq (aref s1 i) (aref s2 i)))
 180             (return i)))
 181         ;; Substrings, equal, nil, or empty ("")
 182         len)))
 183
 184 (defun jabber-activity-make-strings-shorten (jids)
 185   "Return an alist of JID -> names acquired by running
 186 `jabber-activity-make-string' on JIDS, and then shortening the names
 187 as much as possible such that all strings still are unique and at
 188 least `jabber-activity-shorten-minimum' long."
 189   (let ((alist
 190          (sort (mapcar
 191                 #'(lambda (x) (cons x (funcall jabber-activity-make-string x)))
 192                 jids)
 193                #'(lambda (x y) (string-lessp (cdr x) (cdr y))))))
 194     (loop for ((prev-jid . prev) (cur-jid . cur) (next-jid . next))
 195           on (cons nil alist)
 196           until (null cur)
 197           collect
 198           (cons
 199            cur-jid
 200            (substring
 201             cur
 202             0 (min (length cur)
 203                   (max jabber-activity-shorten-minimum
 204                        (1+ (jabber-activity-common-prefix cur prev))
 205                        (1+ (jabber-activity-common-prefix cur next)))))))))
 206
 207 (defun jabber-activity-find-buffer-name (jid)
 208   "Find the name of the buffer that messages from JID would use."
 209   (or (and (jabber-jid-resource jid)
 210            (get-buffer (jabber-muc-private-get-buffer
 211                         (jabber-jid-user jid)
 212                         (jabber-jid-resource jid))))
 213       (get-buffer (jabber-chat-get-buffer jid))
 214       (get-buffer (jabber-muc-get-buffer jid))))
 215
 216 (defun jabber-activity-show-p-default (jid)
 217   "Returns t only if there is an invisible buffer for JID
 218 and JID not in jabber-activity-banned"
 219   (let ((buffer (jabber-activity-find-buffer-name jid)))
 220     (and (buffer-live-p buffer)
 221          (not (get-buffer-window buffer 'visible))
 222          (not (dolist (entry jabber-activity-banned)
 223                 (when (string-match entry jid)
 224                   (return t)))))))
 225
 226 (defun jabber-activity-make-name-alist ()
 227   "Rebuild `jabber-activity-name-alist' based on currently known JIDs"
 228   (let ((jids (or (mapcar #'car jabber-activity-name-alist)
 229                   (mapcar #'symbol-name *jabber-roster*))))
 230     (setq jabber-activity-name-alist
 231           (funcall jabber-activity-make-strings jids))))
 232
 233 (defun jabber-activity-lookup-name (jid)
 234   "Lookup name in `jabber-activity-name-alist', creates an entry
 235 if needed, and returns a (jid . string) pair suitable for the mode line"
 236   (let ((elm (assoc jid jabber-activity-name-alist)))
 237     (if elm
 238         elm
 239       (progn
 240         ;; Remake alist with the new JID
 241         (setq jabber-activity-name-alist
 242               (funcall jabber-activity-make-strings
 243                        (cons jid (mapcar #'car jabber-activity-name-alist))))
 244         (jabber-activity-lookup-name jid)))))
 245
 246 (defun jabber-activity-mode-line-update ()
 247   "Update the string shown in the mode line using `jabber-activity-make-string'
 248 on JIDs where `jabber-activity-show-p'"
 249   (setq jabber-activity-mode-string
 250         (if jabber-activity-jids
 251             (mapconcat
 252              (lambda (x)
 253                (let ((jump-to-jid (car x)))
 254                  (jabber-propertize
 255                   (cdr x)
 256                   'face 'jabber-activity-face
 257                   ;; XXX: XEmacs doesn't have make-mode-line-mouse-map.
 258                   ;; Is there another way to make this work?
 259                   'local-map (when (fboundp 'make-mode-line-mouse-map)
 260                                (make-mode-line-mouse-map
 261                                 'mouse-1 `(lambda ()
 262                                             (interactive)
 263                                             (jabber-activity-switch-to
 264                                              ,(car x)))))
 265                   'help-echo (concat "Jump to "
 266                                      (jabber-jid-displayname (car x))
 267                                      "'s buffer"))))
 268              (mapcar #'jabber-activity-lookup-name
 269                      jabber-activity-jids)
 270              ",")
 271           ""))
 272   (setq jabber-activity-count-string
 273         (number-to-string (length jabber-activity-jids)))
 274   (force-mode-line-update 'all)
 275   (run-hooks 'jabber-activity-update-hook))
 276
 277 ;;; Hooks
 278
 279 (defun jabber-activity-clean ()
 280   "Remove JIDs where `jabber-activity-show-p' no longer is true"
 281   (setq jabber-activity-jids (delete-if-not jabber-activity-show-p
 282                                             jabber-activity-jids))
 283   (jabber-activity-mode-line-update))
 284
 285 (defun jabber-activity-add (from buffer text proposed-alert)
 286   "Add a JID to mode line when `jabber-activity-show-p'"
 287   (when (funcall jabber-activity-show-p from)
 288     (add-to-list 'jabber-activity-jids from)
 289     (jabber-activity-mode-line-update)))
 290
 291 (defun jabber-activity-add-muc (nick group buffer text proposed-alert)
 292   "Add a JID to mode line when `jabber-activity-show-p'"
 293   (when (funcall jabber-activity-show-p group)
 294     (add-to-list 'jabber-activity-jids group)
 295     (jabber-activity-mode-line-update)))
 296
 297 (defun jabber-activity-presence (who oldstatus newstatus statustext proposed-alert)
 298   "Add a JID to mode line on subscription requests."
 299   (when (string= newstatus "subscribe")
 300     (add-to-list 'jabber-activity-jids (symbol-name who))
 301     (jabber-activity-mode-line-update)))
 302
 303 (defun jabber-activity-kill-hook ()
 304   "Query the user as to whether killing Emacs should be cancelled
 305 when there are unread messages which otherwise would be lost, if
 306 `jabber-activity-query-unread' is t"
 307   (if (and jabber-activity-jids
 308            jabber-activity-query-unread)
 309       (yes-or-no-p
 310        "You have unread Jabber messages, are you sure you want to quit?")
 311     t))
 312
 313 ;;; Interactive functions
 314
 315 (defvar jabber-activity-last-buffer nil
 316   "Last non-Jabber buffer used.")
 317
 318 (defun jabber-activity-switch-to (&optional jid-param)
 319   "If JID-PARAM is provided, switch to that buffer.  If JID-PARAM is nil and
 320 there has been activity in another buffer, switch to that buffer.  If no such
 321 buffer exists, switch back to the last non Jabber chat buffer used."
 322     (interactive)
 323     (if (or jid-param jabber-activity-jids)
 324         (let ((jid (or jid-param (car jabber-activity-jids))))
 325           (unless (eq major-mode 'jabber-chat-mode)
 326             (setq jabber-activity-last-buffer (current-buffer)))
 327           (switch-to-buffer (jabber-activity-find-buffer-name jid))
 328           (jabber-activity-clean))
 329       (if (eq major-mode 'jabber-chat-mode)
 330           ;; Switch back to the buffer used last
 331           (when (buffer-live-p jabber-activity-last-buffer)
 332             (switch-to-buffer jabber-activity-last-buffer))
 333         (message "No new activity"))))
 334
 335 (defvar jabber-activity-idle-timer nil "Idle timer used for activity cleaning")
 336
 337 ;;;###autoload
 338 (define-minor-mode jabber-activity-mode
 339   "Toggle display of activity in hidden jabber buffers in the mode line.
 340
 341 With a numeric arg, enable this display if arg is positive."
 342   :global t
 343   :group 'jabber-activity
 344   :init-value t
 345   (if jabber-activity-mode
 346       (progn
 347         ;; XEmacs compatibilty hack from erc-track
 348         (if (featurep 'xemacs)
 349             (defadvice switch-to-buffer (after jabber-activity-update (&rest args) activate)
 350               (jabber-activity-clean))
 351           (add-hook 'window-configuration-change-hook
 352                     'jabber-activity-clean))
 353         (add-hook 'jabber-message-hooks
 354                   'jabber-activity-add)
 355         (add-hook 'jabber-muc-hooks
 356                   'jabber-activity-add-muc)
 357         (add-hook 'jabber-presence-hooks
 358                   'jabber-activity-presence)
 359         (setq jabber-activity-idle-timer (run-with-idle-timer 2 t 'jabber-activity-clean))
 360         ;; XXX: reactivate
 361         ;; (add-hook 'jabber-post-connect-hooks
 362 ;;                'jabber-activity-make-name-alist)
 363         (add-to-list 'kill-emacs-query-functions
 364                      'jabber-activity-kill-hook)
 365         (add-to-list 'global-mode-string
 366                      '(t jabber-activity-mode-string))
 367         (when jabber-activity-count-in-title
 368           ;; Be careful not to override specific meanings of the
 369           ;; existing title format.  In particular, if the car is
 370           ;; a symbol, we can't just add our stuff at the beginning.
 371           ;; If the car is "", we should be safe.
 372           ;;
 373           ;; In my experience, sometimes the activity count gets
 374           ;; included twice in the title.  I'm not sure exactly why,
 375           ;; but it would be nice to replace the code below with
 376           ;; something cleaner.
 377           (if (equal (car frame-title-format) "")
 378               (add-to-list 'frame-title-format
 379                            jabber-activity-count-in-title-format)
 380             (setq frame-title-format (list ""
 381                                            jabber-activity-count-in-title-format
 382                                            frame-title-format)))
 383           (if (equal (car icon-title-format) "")
 384               (add-to-list 'icon-title-format
 385                          jabber-activity-count-in-title-format)
 386             (setq icon-title-format (list ""
 387                                             jabber-activity-count-in-title-format
 388                                             icon-title-format)))))
 389     (progn
 390       (if (featurep 'xemacs)
 391           (ad-disable-advice 'switch-to-buffer 'after 'jabber-activity-update)
 392         (remove-hook 'window-configuration-change-hook
 393                      'jabber-activity-remove-visible))
 394       (remove-hook 'jabber-message-hooks
 395                    'jabber-activity-add)
 396       (remove-hook 'jabber-muc-hooks
 397                    'jabber-activity-add-muc)
 398       (remove-hook 'jabber-presence-hooks
 399                    'jabber-activity-presence)
 400       (ignore-errors (cancel-timer jabber-activity-idle-timer))
 401       ;; XXX: reactivate
 402 ;;       (remove-hook 'jabber-post-connect-hooks
 403 ;;                 'jabber-activity-make-name-alist)
 404       (setq global-mode-string (delete '(t jabber-activity-mode-string)
 405                                        global-mode-string))
 406       (setq frame-title-format
 407             (delete jabber-activity-count-in-title-format
 408                     frame-title-format))
 409       (setq icon-title-format
 410             (delete jabber-activity-count-in-title-format
 411                     icon-title-format)))))
 412
 413 ;; XXX: define-minor-mode should probably do this for us, but it doesn't.
 414 (if jabber-activity-mode (jabber-activity-mode 1))
 415
 416 (provide 'jabber-activity)
 417
 418 ;; arch-tag: 127D7E42-356B-11D9-BE1E-000A95C2FCD0