diff options
Diffstat (limited to 'jabber-muc-nick-completion.el')
| -rw-r--r-- | jabber-muc-nick-completion.el | 188 |
1 files changed, 188 insertions, 0 deletions
diff --git a/jabber-muc-nick-completion.el b/jabber-muc-nick-completion.el new file mode 100644 index 0000000..78ff46d --- /dev/null +++ b/jabber-muc-nick-completion.el @@ -0,0 +1,188 @@ +;;; jabber-muc-nick-completion.el --- Add nick completion abilyty to emacs-jabber + +;; Copyright (C) 2008 - Terechkov Evgenii - evg@altlinux.org +;; Copyright (C) 2007, 2008, 2010 - Kirill A. Korinskiy - catap@catap.ru +;; Copyright (C) 2007 - Serguei Jidkov - jsv@e-mail.ru + +;; This file is a part of jabber.el. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +;;; User customizations here: +(defcustom jabber-muc-completion-delimiter ": " + "String to add to end of completion line." + :type 'string + :group 'jabber-chat) + +(defcustom jabber-muc-looks-personaling-symbols '("," ":" ">") + "Symbols for personaling messages" + :type '(repeat string) + :group 'jabber-chat) + +(defcustom jabber-muc-personal-message-bonus (* 60 20) + "Bonus for personal message, in seconds." + :type 'integer + :group 'jabber-chat) + +(defcustom jabber-muc-all-string "all" + "String meaning all conference members (to insert in completion). Note that \":\" or alike not needed (it appended in other string)" + :type 'string + :group 'jabber-chat) + +;;; History: +;; + +;;; Code: + +(require 'cl) +(require 'jabber-muc) +(require 'hippie-exp) + +(defvar *jabber-muc-participant-last-speaking* nil + "Global alist in form (group . ((member . time-of-last-speaking) ...) ...).") + +(defun jabber-my-nick (&optional group) + "Return my jabber nick in GROUP." + (let ((room (or group jabber-group))) + (cdr (or (assoc room *jabber-active-groupchats*) + (assoc room jabber-muc-default-nicknames))) + )) + +;;;###autoload +(defun jabber-muc-looks-like-personal-p (message &optional group) + "Return non-nil if jabber MESSAGE is addresed to me. +Optional argument GROUP to look." + (if message (string-match (concat + "^" + (jabber-my-nick group) + (regexp-opt jabber-muc-looks-personaling-symbols)) + message) + nil)) + +(defun jabber-muc-nicknames () + "List of conference participants, excluding self, or nil if we not in conference." + (delete-if '(lambda (nick) + (string= nick (jabber-my-nick))) + (append (mapcar 'car (cdr (assoc jabber-group jabber-muc-participants))) (list jabber-muc-all-string)))) + +(defun jabber-muc-participant-update-activity (group nick time) + "Updates NICK's time of last speaking in GROUP to TIME." + (let* ((room (assoc group *jabber-muc-participant-last-speaking*)) + (room-activity (cdr room)) + (entry (assoc nick room-activity)) + (old-time (or (cdr entry) 0))) + (when (> time old-time) + ;; don't use put-alist for speed + (progn + (if entry (setcdr entry time) + (setq room-activity + (cons (cons nick time) room-activity))) + (if room (setcdr room room-activity) + (setq *jabber-muc-participant-last-speaking* + (cons (cons group room-activity) + *jabber-muc-participant-last-speaking*))))))) + +(defun jabber-muc-track-message-time (nick group buffer text &optional title) + "Tracks time of NICK's last speaking in GROUP." + (when nick + (let ((time (float-time))) + (jabber-muc-participant-update-activity + group + nick + (if (jabber-muc-looks-like-personal-p text group) + (+ time jabber-muc-personal-message-bonus) + time))))) + +(defun jabber-sort-nicks (nicks group) + "Return list of NICKS in GROUP, sorted." + (let ((times (cdr (assoc group *jabber-muc-participant-last-speaking*)))) + (flet ((fetch-time (nick) (or (assoc nick times) (cons nick 0))) + (cmp (nt1 nt2) + (let ((t1 (cdr nt1)) + (t2 (cdr nt2))) + (if (and (zerop t1) (zerop t2)) + (string< + (car nt1) + (car nt2)) + (> t1 t2))))) + (mapcar 'car (sort (mapcar 'fetch-time nicks) + 'cmp))))) + +(defun jabber-muc-beginning-of-line () + "Return position of line begining." + (save-excursion + (if (looking-back jabber-muc-completion-delimiter) + (backward-char (+ (length jabber-muc-completion-delimiter) 1))) + (skip-syntax-backward "^-") + (point))) + +;;; One big hack: +(defun jabber-muc-completion-delete-last-tried () + "Delete last tried competion variand from line." + (let ((last-tried (car he-tried-table))) + (when last-tried + (goto-char he-string-beg) + (delete-char (length last-tried)) + (ignore-errors (delete-char (length jabber-muc-completion-delimiter))) + ))) + +(defun try-expand-jabber-muc (old) + "Try to expand target nick in MUC according to last speaking time. +OLD is last tried nickname." + (unless jabber-chatting-with + (unless old + (let ((nicknames (jabber-muc-nicknames))) + (he-init-string (jabber-muc-beginning-of-line) (point)) + (setq he-expand-list (jabber-sort-nicks (all-completions he-search-string (mapcar 'list nicknames)) jabber-group)))) + + (setq he-expand-list + (delete-if '(lambda (x) + (he-string-member x he-tried-table)) + he-expand-list)) + (if (null he-expand-list) + (progn + (when old + ;; here and later : its hack to workaround + ;; he-substitute-string work which cant substitute empty + ;; lines + (if (string= he-search-string "") + (jabber-muc-completion-delete-last-tried) + (he-reset-string))) + ()) + (let ((subst (if (eq (line-beginning-position) (jabber-muc-beginning-of-line)) + (concat (car he-expand-list) jabber-muc-completion-delimiter) + (car he-expand-list)))) + (if (not (string= he-search-string "")) + (he-substitute-string subst) + (jabber-muc-completion-delete-last-tried) + (progn + (insert subst) + (if (looking-back (concat "^" (regexp-quote (car he-expand-list)))) + (unless (looking-back (concat "^" (regexp-quote (car he-expand-list)) jabber-muc-completion-delimiter)) + (insert jabber-muc-completion-delimiter))) + ) + )) + (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table))) + (setq he-expand-list (cdr he-expand-list)) + t))) + +(add-hook 'jabber-muc-hooks 'jabber-muc-track-message-time) +(fset 'jabber-muc-completion (make-hippie-expand-function '(try-expand-jabber-muc))) +(define-key jabber-chat-mode-map [?\t] 'jabber-muc-completion) + +(provide 'jabber-muc-nick-completion) + +;; arch-tag: 2a81ac72-d261-11dc-be91-000a95c2fcd0 +;;; jabber-muc-completion.el ends here |