djavu-asus/elpa/jabber-20230715.456/jabber-modeline.el

   1 ;; jabber-modeline.el - display jabber status in modeline  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2004 - Magnus Henoch - mange@freemail.hu
   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 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program 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 this program; if not, write to the Free Software
  19 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20
  21 (require 'jabber-presence)
  22 (require 'jabber-alert)
  23 (eval-when-compile (require 'cl-lib))
  24
  25 (defgroup jabber-mode-line nil
  26   "Display Jabber status in mode line"
  27   :group 'jabber)
  28
  29 (defcustom jabber-mode-line-compact t
  30   "Count contacts in fewer categories for compact view."
  31   :group 'jabber-mode-line
  32   :type 'boolean)
  33
  34 (defvar jabber-mode-line-string nil)
  35
  36 (defvar jabber-mode-line-presence nil)
  37
  38 (defvar jabber-mode-line-contacts nil)
  39
  40 (defadvice jabber-send-presence (after jsp-update-mode-line
  41                                        (show status priority))
  42   (jabber-mode-line-presence-update))
  43
  44 (defun jabber-mode-line-presence-update ()
  45   (setq jabber-mode-line-presence (if (and jabber-connections (not *jabber-disconnecting*))
  46                                       (cdr (assoc *jabber-current-show* jabber-presence-strings))
  47                                     "Offline")))
  48
  49 (defun jabber-mode-line-count-contacts (&rest _ignore)
  50   (let ((count (list (cons "chat" 0)
  51                      (cons "" 0)
  52                      (cons "away" 0)
  53                      (cons "xa" 0)
  54                      (cons "dnd" 0)
  55                      (cons nil 0))))
  56     (dolist (jc jabber-connections)
  57       (dolist (buddy (plist-get (fsm-get-state-data jc) :roster))
  58         (when (assoc (get buddy 'show) count)
  59           (cl-incf (cdr (assoc (get buddy 'show) count))))))
  60     (setq jabber-mode-line-contacts
  61           (if jabber-mode-line-compact
  62               (format "(%d/%d/%d)"
  63                       (+ (cdr (assoc "chat" count))
  64                          (cdr (assoc "" count)))
  65                       (+ (cdr (assoc "away" count))
  66                          (cdr (assoc "xa" count))
  67                          (cdr (assoc "dnd" count)))
  68                       (cdr (assoc nil count)))
  69             (apply 'format "(%d/%d/%d/%d/%d/%d)"
  70                    (mapcar 'cdr count))))))
  71
  72 (define-minor-mode jabber-mode-line-mode
  73   "Toggle display of Jabber status in mode lines.
  74 Display consists of your own status, and six numbers
  75 meaning the number of chatty, online, away, xa, dnd
  76 and offline contacts, respectively."
  77   :global t :group 'jabber-mode-line
  78   (setq jabber-mode-line-string "")
  79   (or global-mode-string (setq global-mode-string '("")))
  80   (if jabber-mode-line-mode
  81       (progn
  82         (add-to-list 'global-mode-string 'jabber-mode-line-string t)
  83
  84         (setq jabber-mode-line-string (list " "
  85                                             'jabber-mode-line-presence
  86                                             " "
  87                                             'jabber-mode-line-contacts))
  88         (put 'jabber-mode-line-string 'risky-local-variable t)
  89         (put 'jabber-mode-line-presence 'risky-local-variable t)
  90         (jabber-mode-line-presence-update)
  91         (jabber-mode-line-count-contacts)
  92         (ad-activate 'jabber-send-presence)
  93         (add-hook 'jabber-post-disconnect-hook
  94                   'jabber-mode-line-presence-update)
  95         (add-hook 'jabber-presence-hooks
  96                   'jabber-mode-line-count-contacts))))
  97
  98 (provide 'jabber-modeline)
  99
 100 ;;; arch-tag: c03a7d3b-8811-49d4-b0e0-7ffd661d7925