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