djavu-asus/emacs/elpa/jabber-20230715.456/jabber-activity.el

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