189 lines
6.7 KiB
EmacsLisp
189 lines
6.7 KiB
EmacsLisp
;;; 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
|