| | 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 |
projects / config.git / blame_incremental