emacs-jabber jabber-chat.el, 1.81, 1.82 jabber-presence.el, 1.33, 1.34 NEWS, 1.61, 1.62 jabber-activity.el, 1.29, 1.30

[Magnus H. <leg...@us...>]

Update of /cvsroot/emacs-jabber/emacs-jabber
In directory sc8-pr-cvs17:/tmp/cvs-serv8974

Modified Files:
	jabber-chat.el jabber-presence.el NEWS jabber-activity.el 
Log Message:
Revision: ma...@fr...--2005/emacs-jabber--cvs-head--0--patch-410
Creator:  Magnus Henoch <ma...@fr...>

Subscription requests are sent to chat buffers


Index: jabber-chat.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-chat.el,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -d -r1.81 -r1.82
--- jabber-chat.el	31 Aug 2007 21:45:03 -0000	1.81
+++ jabber-chat.el	14 Sep 2007 23:14:03 -0000	1.82
@@ -349,7 +349,7 @@
 	 (jabber-chat-self-prompt (or (jabber-x-delay original-timestamp)
 				      internal-time)
 				  delayed))
-	(:foreign
+	((:foreign :subscription-request)
 	 ;; For :error and :notice, this might be a string... beware
 	 (jabber-chat-print-prompt (when (listp (cadr data)) (cadr data)) 
 				   (or (jabber-x-delay original-timestamp)
@@ -380,7 +380,24 @@
        (insert (cadr data)))
       (:rare-time
        (insert (jabber-propertize (format-time-string jabber-rare-time-format (cadr data))
-				  'face 'jabber-rare-time-face))))
+				  'face 'jabber-rare-time-face)))
+      (:subscription-request
+       (insert "This user requests subscription to your presence.\n")
+       (when (and (stringp (cadr data)) (not (zerop (length (cadr data)))))
+	 (insert "Message: " (cadr data) "\n"))
+       (insert "Accept?\n\n")
+       (flet ((button
+	       (text action)
+	       (if (fboundp 'insert-button)
+		   (insert-button text 'action action)
+		 ;; simple button replacement
+		 (let ((keymap (make-keymap)))
+		   (define-key keymap "\r" action)
+		   (insert (jabber-propertize text 'keymap keymap 'face 'highlight))))
+	       (insert "\t")))
+	 (button "Mutual" 'jabber-subscription-accept-mutual)
+	 (button "One-way" 'jabber-subscription-accept-one-way)
+	 (button "Decline" 'jabber-subscription-decline))))
 
     (when jabber-chat-fill-long-lines
       (save-restriction

Index: NEWS
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/NEWS,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -d -r1.61 -r1.62
--- NEWS	24 Aug 2007 02:43:50 -0000	1.61
+++ NEWS	14 Sep 2007 23:14:03 -0000	1.62
@@ -29,6 +29,9 @@
 See jabber-browse-buffer-format.
 (not documented yet)
 
+** Subscription requests are sent to chat buffers
+(not documented yet)
+
 * New features in jabber.el 0.7.1
 
 ** STARTTLS

Index: jabber-activity.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-activity.el,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- jabber-activity.el	7 Aug 2007 17:02:19 -0000	1.29
+++ jabber-activity.el	14 Sep 2007 23:14:03 -0000	1.30
@@ -277,6 +277,12 @@
     (add-to-list 'jabber-activity-jids group)
     (jabber-activity-mode-line-update)))
 
+(defun jabber-activity-presence (who oldstatus newstatus statustext proposed-alert)
+  "Add a JID to mode line on subscription requests."
+  (when (string= newstatus "subscribe")
+    (add-to-list 'jabber-activity-jids (symbol-name who))
+    (jabber-activity-mode-line-update)))
+
 (defun jabber-activity-kill-hook ()
   "Query the user as to whether killing Emacs should be cancelled
 when there are unread messages which otherwise would be lost, if
@@ -327,6 +333,8 @@
 		  'jabber-activity-add)
 	(add-hook 'jabber-muc-hooks
 		  'jabber-activity-add-muc)
+	(add-hook 'jabber-presence-hooks
+		  'jabber-activity-presence)
 	;; XXX: reactivate
 	;; (add-hook 'jabber-post-connect-hooks
 ;; 		  'jabber-activity-make-name-alist)
@@ -360,6 +368,8 @@
 		   'jabber-activity-add)
       (remove-hook 'jabber-muc-hooks
 		   'jabber-activity-add-muc)
+      (remove-hook 'jabber-presence-hooks
+		   'jabber-activity-presence)
       ;; XXX: reactivate
 ;;       (remove-hook 'jabber-post-connect-hooks
 ;; 		   'jabber-activity-make-name-alist)

Index: jabber-presence.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-presence.el,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- jabber-presence.el	20 Mar 2007 11:49:41 -0000	1.33
+++ jabber-presence.el	14 Sep 2007 23:14:03 -0000	1.34
@@ -1,7 +1,7 @@
 ;; jabber-presence.el - roster and presence bookkeeping
 
+;; Copyright (C) 2003, 2004, 2007 - Magnus Henoch - ma...@fr...
 ;; Copyright (C) 2002, 2003, 2004 - tom berger - ob...@in...
-;; Copyright (C) 2003, 2004 - Magnus Henoch - ma...@fr...
 
 ;; This file is a part of jabber.el.
 
@@ -193,23 +193,25 @@
 
 (defun jabber-process-subscription-request (jc from presence-status)
   "process an incoming subscription request"
-  (dolist (hook '(jabber-presence-hooks jabber-alert-presence-hooks))
-    (run-hook-with-args hook (jabber-jid-symbol from) nil "subscribe" presence-status (funcall jabber-alert-presence-message-function (jabber-jid-symbol from) nil "subscribe" presence-status)))
-  (jabber-send-sexp 
-   jc
-   (list 'presence
-	 (list (cons 'to from)
-	       (cons 'type
-		     (if (yes-or-no-p (format "the user  - %s -  has requested to subscribe to your presence (%s). allow? "
-					      (jabber-jid-displayname from)
-					      presence-status))
-			 "subscribed"
-		       "unsubscribed")))))
-  (when (yes-or-no-p (format "Do you want to subscribe to %s's presence? " from))
-    (jabber-send-sexp
-     jc
-     (list 'presence (list (cons 'to from)
-			   (cons 'type "subscribe"))))))
+  (with-current-buffer (jabber-chat-create-buffer jc from)
+    (ewoc-enter-last jabber-chat-ewoc (list :subscription-request presence-status :time (current-time)))
+
+    (dolist (hook '(jabber-presence-hooks jabber-alert-presence-hooks))
+      (run-hook-with-args hook (jabber-jid-symbol from) nil "subscribe" presence-status (funcall jabber-alert-presence-message-function (jabber-jid-symbol from) nil "subscribe" presence-status)))))
+
+(defun jabber-subscription-accept-mutual (&rest ignored)
+  (jabber-subscription-reply "subscribed" "subscribe"))
+
+(defun jabber-subscription-accept-one-way (&rest ignored)
+  (jabber-subscription-reply "subscribed"))
+
+(defun jabber-subscription-decline (&rest ignored)
+  (jabber-subscription-reply "unsubscribed"))
+
+(defun jabber-subscription-reply (&rest types)
+  (let ((to (jabber-jid-user jabber-chatting-with)))
+    (dolist (type types)
+      (jabber-send-sexp jabber-buffer-connection `(presence ((to . ,to) (type . ,type)))))))
 
 (defun jabber-prioritize-resources (buddy)
   "Set connected, show and status properties for BUDDY from highest-priority resource."