projects / config.git / blame
| Commit | Line | Data |
|---|---|---|
| 53e6db90 DC |
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 |