Se agregan las configuraciones del tarro

[config.git] / djavu-asus / elpa / jabber-20230715.456 / jabber-muc-nick-completion.el

;;; jabber-muc-nick-completion.el --- MUC nick completion  -*- lexical-binding: t; -*-

;; 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)


;;; Commentary:
;;

;;; History:
;;

;;; Code:

(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."
  (cl-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)
  "Update 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."
    (cl-letf* ((times (cdr (assoc group *jabber-muc-participant-last-speaking*)))
	       ((symbol-function 'fetch-time) (lambda (nick) (or (assoc nick times)
								 (cons nick 0))))
	       ((symbol-function 'cmp) (lambda (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 (line-beginning-position))
        (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
	  (cl-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))) nil)
                (unless (looking-back (concat "^" (regexp-quote (car he-expand-list)) jabber-muc-completion-delimiter)
                                      nil)
                  (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)))
(with-eval-after-load 'jabber-chatbuffer
  (define-key jabber-chat-mode-map [?\t] 'jabber-muc-completion))

(provide 'jabber-muc-nick-completion)

;; arch-tag: 2a81ac72-d261-11dc-be91-000a95c2fcd0
;;; jabber-muc-nick-completion.el ends here