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 (defface jabber-activity-face
 127   '((t (:foreground "red" :weight bold)))
 128   "The face for displaying jabber-activity-string in the mode line"
 129   :group 'jabber-activity)
 130
 131 (defvar jabber-activity-jids nil
 132   "A list of JIDs which have caused activity")
 133
 134 (defvar jabber-activity-name-alist nil
 135   "Alist of mode line names for bare JIDs")
 136
 137 (defvar jabber-activity-mode-string ""
 138   "The mode string for jabber activity")
 139
 140 (defvar jabber-activity-count-string "0"
 141   "Number of active JIDs as a string.")
 142
 143 (defvar jabber-activity-update-hook nil
 144   "Hook called when `jabber-activity-jids' changes.
 145 It is called after `jabber-activity-mode-string' and
 146 `jabber-activity-count-string' are updated.")
 147
 148 ;; Protect this variable from being set in Local variables etc.
 149 (put 'jabber-activity-mode-string 'risky-local-variable t)
 150 (put 'jabber-activity-count-string 'risky-local-variable t)
 151
 152 (defun jabber-activity-make-string-default (jid)
 153   "Return the nick of the JID.  If no nick is available, return
 154 the user name part of the JID.  In private MUC conversations,
 155 return the user's nickname."
 156   (if (jabber-muc-sender-p jid)
 157       (jabber-jid-resource jid)
 158     (let ((nick (jabber-jid-displayname jid))
 159           (user (jabber-jid-user jid))
 160           (username (jabber-jid-username jid)))
 161       (if (and username (string= nick user))
 162           username
 163         nick))))
 164
 165 (defun jabber-activity-make-strings-default (jids)
 166   "Apply `jabber-activity-make-string' on JIDS"
 167   (mapcar #'(lambda (jid) (cons jid (funcall jabber-activity-make-string jid)))
 168           jids))
 169
 170 (defun jabber-activity-common-prefix (s1 s2)
 171   "Return length of common prefix string shared by S1 and S2"
 172   (let ((len (min (length s1) (length s2))))
 173     (or (dotimes (i len)
 174           (when (not (eq (aref s1 i) (aref s2 i)))
 175             (return i)))
 176         ;; Substrings, equal, nil, or empty ("")
 177         len)))
 178
 179 (defun jabber-activity-make-strings-shorten (jids)
 180   "Return an alist of JID -> names acquired by running
 181 `jabber-activity-make-string' on JIDS, and then shortening the names
 182 as much as possible such that all strings still are unique and at
 183 least `jabber-activity-shorten-minimum' long."
 184   (let ((alist
 185          (sort (mapcar
 186                 #'(lambda (x) (cons x (funcall jabber-activity-make-string x)))
 187                 jids)
 188                #'(lambda (x y) (string-lessp (cdr x) (cdr y))))))
 189     (loop for ((prev-jid . prev) (cur-jid . cur) (next-jid . next))
 190           on (cons nil alist)
 191           until (null cur)
 192           collect
 193           (cons
 194            cur-jid
 195            (substring
 196             cur
 197             0 (min (length cur)
 198                   (max jabber-activity-shorten-minimum
 199                        (1+ (jabber-activity-common-prefix cur prev))
 200                        (1+ (jabber-activity-common-prefix cur next)))))))))
 201
 202 (defun jabber-activity-find-buffer-name (jid)
 203   "Find the name of the buffer that messages from JID would use."
 204   (or (and (jabber-jid-resource jid)
 205            (get-buffer (jabber-muc-private-get-buffer
 206                         (jabber-jid-user jid)
 207                         (jabber-jid-resource jid))))
 208       (get-buffer (jabber-chat-get-buffer jid))
 209       (get-buffer (jabber-muc-get-buffer jid))))
 210
 211 (defun jabber-activity-show-p-default (jid)
 212   "Returns t only if there is an invisible buffer for JID"
 213   (let ((buffer (jabber-activity-find-buffer-name jid)))
 214     (and (buffer-live-p buffer)
 215          (not (get-buffer-window buffer 'visible)))))
 216
 217 (defun jabber-activity-make-name-alist ()
 218   "Rebuild `jabber-activity-name-alist' based on currently known JIDs"
 219   (let ((jids (or (mapcar #'car jabber-activity-name-alist)
 220                   (mapcar #'symbol-name *jabber-roster*))))
 221     (setq jabber-activity-name-alist
 222           (funcall jabber-activity-make-strings jids))))
 223
 224 (defun jabber-activity-lookup-name (jid)
 225   "Lookup name in `jabber-activity-name-alist', creates an entry
 226 if needed, and returns a (jid . string) pair suitable for the mode line"
 227   (let ((elm (assoc jid jabber-activity-name-alist)))
 228     (if elm
 229         elm
 230       (progn
 231         ;; Remake alist with the new JID
 232         (setq jabber-activity-name-alist
 233               (funcall jabber-activity-make-strings
 234                        (cons jid (mapcar #'car jabber-activity-name-alist))))
 235         (jabber-activity-lookup-name jid)))))
 236
 237 (defun jabber-activity-mode-line-update ()
 238   "Update the string shown in the mode line using `jabber-activity-make-string'
 239 on JIDs where `jabber-activity-show-p'"
 240   (setq jabber-activity-mode-string
 241         (if jabber-activity-jids
 242             (mapconcat
 243              (lambda (x)
 244                (let ((jump-to-jid (car x)))
 245                  (jabber-propertize
 246                   (cdr x)
 247                   'face 'jabber-activity-face
 248                   ;; XXX: XEmacs doesn't have make-mode-line-mouse-map.
 249                   ;; Is there another way to make this work?
 250                   'local-map (when (fboundp 'make-mode-line-mouse-map)
 251                                (make-mode-line-mouse-map
 252                                 'mouse-1 `(lambda ()
 253                                             (interactive)
 254                                             (jabber-activity-switch-to
 255                                              ,(car x)))))
 256                   'help-echo (concat "Jump to "
 257                                      (jabber-jid-displayname (car x))
 258                                      "'s buffer"))))
 259              (mapcar #'jabber-activity-lookup-name
 260                      jabber-activity-jids)
 261              ",")
 262           ""))
 263   (setq jabber-activity-count-string
 264         (number-to-string (length jabber-activity-jids)))
 265   (force-mode-line-update 'all)
 266   (run-hooks 'jabber-activity-update-hook))
 267
 268 ;;; Hooks
 269
 270 (defun jabber-activity-clean ()
 271   "Remove JIDs where `jabber-activity-show-p' no longer is true"
 272   (setq jabber-activity-jids (delete-if-not jabber-activity-show-p
 273                                             jabber-activity-jids))
 274   (jabber-activity-mode-line-update))
 275
 276 (defun jabber-activity-add (from buffer text proposed-alert)
 277   "Add a JID to mode line when `jabber-activity-show-p'"
 278   (when (funcall jabber-activity-show-p from)
 279     (add-to-list 'jabber-activity-jids from)
 280     (jabber-activity-mode-line-update)))
 281
 282 (defun jabber-activity-add-muc (nick group buffer text proposed-alert)
 283   "Add a JID to mode line when `jabber-activity-show-p'"
 284   (when (funcall jabber-activity-show-p group)
 285     (add-to-list 'jabber-activity-jids group)
 286     (jabber-activity-mode-line-update)))
 287
 288 (defun jabber-activity-presence (who oldstatus newstatus statustext proposed-alert)
 289   "Add a JID to mode line on subscription requests."
 290   (when (string= newstatus "subscribe")
 291     (add-to-list 'jabber-activity-jids (symbol-name who))
 292     (jabber-activity-mode-line-update)))
 293
 294 (defun jabber-activity-kill-hook ()
 295   "Query the user as to whether killing Emacs should be cancelled
 296 when there are unread messages which otherwise would be lost, if
 297 `jabber-activity-query-unread' is t"
 298   (if (and jabber-activity-jids
 299            jabber-activity-query-unread)
 300       (yes-or-no-p
 301        "You have unread Jabber messages, are you sure you want to quit?")
 302     t))
 303
 304 ;;; Interactive functions
 305
 306 (defvar jabber-activity-last-buffer nil
 307   "Last non-Jabber buffer used.")
 308
 309 (defun jabber-activity-switch-to (&optional jid-param)
 310   "If JID-PARAM is provided, switch to that buffer.  If JID-PARAM is nil and
 311 there has been activity in another buffer, switch to that buffer.  If no such
 312 buffer exists, switch back to the last non Jabber chat buffer used."
 313     (interactive)
 314     (if (or jid-param jabber-activity-jids)
 315         (let ((jid (or jid-param (car jabber-activity-jids))))
 316           (unless (eq major-mode 'jabber-chat-mode)
 317             (setq jabber-activity-last-buffer (current-buffer)))
 318           (switch-to-buffer (jabber-activity-find-buffer-name jid))
 319           (jabber-activity-clean))
 320       (if (eq major-mode 'jabber-chat-mode)
 321           ;; Switch back to the buffer used last
 322           (when (buffer-live-p jabber-activity-last-buffer)
 323             (switch-to-buffer jabber-activity-last-buffer))
 324         (message "No new activity"))))
 325
 326 (defvar jabber-activity-idle-timer nil "Idle timer used for activity cleaning")
 327
 328 ;;;###autoload
 329 (define-minor-mode jabber-activity-mode
 330   "Toggle display of activity in hidden jabber buffers in the mode line.
 331
 332 With a numeric arg, enable this display if arg is positive."
 333   :global t
 334   :group 'jabber-activity
 335   :init-value t
 336   (if jabber-activity-mode
 337       (progn
 338         ;; XEmacs compatibilty hack from erc-track
 339         (if (featurep 'xemacs)
 340             (defadvice switch-to-buffer (after jabber-activity-update (&rest args) activate)
 341               (jabber-activity-clean))
 342           (add-hook 'window-configuration-change-hook
 343                     'jabber-activity-clean))
 344         (add-hook 'jabber-message-hooks
 345                   'jabber-activity-add)
 346         (add-hook 'jabber-muc-hooks
 347                   'jabber-activity-add-muc)
 348         (add-hook 'jabber-presence-hooks
 349                   'jabber-activity-presence)
 350         (setq jabber-activity-idle-timer (run-with-idle-timer 2 t 'jabber-activity-clean))
 351         ;; XXX: reactivate
 352         ;; (add-hook 'jabber-post-connect-hooks
 353 ;;                'jabber-activity-make-name-alist)
 354         (add-to-list 'kill-emacs-query-functions
 355                      'jabber-activity-kill-hook)
 356         (add-to-list 'global-mode-string
 357                      '(t jabber-activity-mode-string))
 358         (when jabber-activity-count-in-title
 359           ;; Be careful not to override specific meanings of the
 360           ;; existing title format.  In particular, if the car is
 361           ;; a symbol, we can't just add our stuff at the beginning.
 362           ;; If the car is "", we should be safe.
 363           ;;
 364           ;; In my experience, sometimes the activity count gets
 365           ;; included twice in the title.  I'm not sure exactly why,
 366           ;; but it would be nice to replace the code below with
 367           ;; something cleaner.
 368           (if (equal (car frame-title-format) "")
 369               (add-to-list 'frame-title-format
 370                            jabber-activity-count-in-title-format)
 371             (setq frame-title-format (list ""
 372                                            jabber-activity-count-in-title-format
 373                                            frame-title-format)))
 374           (if (equal (car icon-title-format) "")
 375               (add-to-list 'icon-title-format
 376                          jabber-activity-count-in-title-format)
 377             (setq icon-title-format (list ""
 378                                             jabber-activity-count-in-title-format
 379                                             icon-title-format)))))
 380     (progn
 381       (if (featurep 'xemacs)
 382           (ad-disable-advice 'switch-to-buffer 'after 'jabber-activity-update)
 383         (remove-hook 'window-configuration-change-hook
 384                      'jabber-activity-remove-visible))
 385       (remove-hook 'jabber-message-hooks
 386                    'jabber-activity-add)
 387       (remove-hook 'jabber-muc-hooks
 388                    'jabber-activity-add-muc)
 389       (remove-hook 'jabber-presence-hooks
 390                    'jabber-activity-presence)
 391       (ignore-errors (cancel-timer jabber-activity-idle-timer))
 392       ;; XXX: reactivate
 393 ;;       (remove-hook 'jabber-post-connect-hooks
 394 ;;                 'jabber-activity-make-name-alist)
 395       (setq global-mode-string (delete '(t jabber-activity-mode-string)
 396                                        global-mode-string))
 397       (setq frame-title-format
 398             (delete jabber-activity-count-in-title-format
 399                     frame-title-format))
 400       (setq icon-title-format
 401             (delete jabber-activity-count-in-title-format
 402                     icon-title-format)))))
 403
 404 ;; XXX: define-minor-mode should probably do this for us, but it doesn't.
 405 (if jabber-activity-mode (jabber-activity-mode 1))
 406
 407 (provide 'jabber-activity)
 408
 409 ;; arch-tag: 127D7E42-356B-11D9-BE1E-000A95C2FCD0