Menu
▾
▴
emacs-jabber-commit — jabber.el commit messages
You can subscribe to this list here.
| 2007 |
Jan
|
Feb
|
Mar
|
Apr
(4) |
May
(13) |
Jun
(3) |
Jul
(4) |
Aug
(30) |
Sep
(17) |
Oct
(2) |
Nov
(6) |
Dec
(9) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2008 |
Jan
(9) |
Feb
(30) |
Mar
(22) |
Apr
(23) |
May
(25) |
Jun
(25) |
Jul
(4) |
Aug
(21) |
Sep
(16) |
Oct
(44) |
Nov
(15) |
Dec
(3) |
| 2009 |
Jan
(9) |
Feb
(6) |
Mar
(2) |
Apr
(2) |
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(4) |
Oct
|
Nov
|
Dec
|
| 2010 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
(2) |
Oct
(3) |
Nov
|
Dec
|
| 2011 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(5) |
Sep
|
Oct
(3) |
Nov
|
Dec
(2) |
| 2012 |
Jan
|
Feb
(3) |
Mar
|
Apr
(3) |
May
(2) |
Jun
(2) |
Jul
(1) |
Aug
|
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
(3) |
Feb
(4) |
Mar
|
Apr
(4) |
May
(2) |
Jun
(1) |
Jul
(3) |
Aug
(3) |
Sep
(1) |
Oct
(1) |
Nov
(10) |
Dec
|
| 2014 |
Jan
(6) |
Feb
(2) |
Mar
|
Apr
(3) |
May
(8) |
Jun
(5) |
Jul
(2) |
Aug
(6) |
Sep
(2) |
Oct
(1) |
Nov
|
Dec
(2) |
| 2015 |
Jan
(1) |
Feb
(2) |
Mar
(2) |
Apr
(6) |
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
(4) |
Nov
|
Dec
|
| 2016 |
Jan
(2) |
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
(1) |
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2018 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
|
Dec
|
|
From: Magnus H. <leg...@us...> - 2014-02-25 10:02:00
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 2964c95b33ca2f4e0c8b24d08dd05877b270d5f9 (commit)
from d28b65ee43845a48d569738c8a64d8410c6e4211 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 2964c95b33ca2f4e0c8b24d08dd05877b270d5f9
Author: Magnus Henoch <mag...@gm...>
Date: Tue Feb 25 09:31:44 2014 +0000
Fix call to jabber-activity-mode-line-update
It doesn't take any arguments anymore.
diff --git a/jabber-activity.el b/jabber-activity.el
index 5d292c5..430283e 100644
--- a/jabber-activity.el
+++ b/jabber-activity.el
@@ -310,7 +310,7 @@ Optional PRESENCE mean personal presence request or alert."
(add-to-list 'jabber-activity-jids group)
(when (jabber-muc-looks-like-personal-p text group)
(add-to-list 'jabber-activity-personal-jids group))
- (jabber-activity-mode-line-update group text)))
+ (jabber-activity-mode-line-update)))
(defun jabber-activity-presence (who oldstatus newstatus statustext proposed-alert)
"Add a JID to mode line on subscription requests."
-----------------------------------------------------------------------
Summary of changes:
jabber-activity.el | 2 +-
1 files changed, 1 insertions(+), 1 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2014-02-07 22:21:19
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via d28b65ee43845a48d569738c8a64d8410c6e4211 (commit)
from 85b8468f5e4659ca2515a60cd5219aac6dba94fd (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit d28b65ee43845a48d569738c8a64d8410c6e4211
Author: Magnus Henoch <mag...@gm...>
Date: Fri Feb 7 22:18:01 2014 +0000
Fix "personal" face in jabber-activity
We can't distinguish "personal" vs "non-personal" in
jabber-activity-mode-line-update, since that loops over _all_ entries in
jabber-activity-jids each time, and thus the JIDs will be marked either
all personal or all non-personal. Instead, let's keep a separate list,
jabber-activity-personal-jids, which is updated when activity is logged
for a JID.
diff --git a/jabber-activity.el b/jabber-activity.el
index 90bfa30..5d292c5 100644
--- a/jabber-activity.el
+++ b/jabber-activity.el
@@ -141,6 +141,9 @@ there are unread messages which otherwise would be lost."
(defvar jabber-activity-jids nil
"A list of JIDs which have caused activity")
+(defvar jabber-activity-personal-jids nil
+ "Subset of `jabber-activity-jids' for JIDs with \"personal\" activity.")
+
(defvar jabber-activity-name-alist nil
"Alist of mode line names for bare JIDs")
@@ -248,7 +251,7 @@ if needed, and returns a (jid . string) pair suitable for the mode line"
(cons jid (mapcar #'car jabber-activity-name-alist))))
(jabber-activity-lookup-name jid)))))
-(defun jabber-activity-mode-line-update (&optional group text presence)
+(defun jabber-activity-mode-line-update ()
"Update the string shown in the mode line using `jabber-activity-make-string'
on JIDs where `jabber-activity-show-p'. Optional not-nil GROUP mean that message come from MUC.
Optional TEXT used with one-to-one or MUC chats and may be used to identify personal MUC message.
@@ -260,13 +263,9 @@ Optional PRESENCE mean personal presence request or alert."
(let ((jump-to-jid (car x)))
(jabber-propertize
(cdr x)
- 'face (if (or
- (and group text (jabber-muc-looks-like-personal-p text group)) ;MUC message
- (and (not group) text) ;one-to-one chat message
- presence ;presence request/alert
- )
- 'jabber-activity-personal-face
- 'jabber-activity-face)
+ 'face (if (member jump-to-jid jabber-activity-personal-jids)
+ 'jabber-activity-personal-face
+ 'jabber-activity-face)
;; XXX: XEmacs doesn't have make-mode-line-mouse-map.
;; Is there another way to make this work?
'local-map (when (fboundp 'make-mode-line-mouse-map)
@@ -293,25 +292,32 @@ Optional PRESENCE mean personal presence request or alert."
"Remove JIDs where `jabber-activity-show-p' no longer is true"
(setq jabber-activity-jids (delete-if-not jabber-activity-show-p
jabber-activity-jids))
+ (setq jabber-activity-personal-jids
+ (delete-if-not jabber-activity-show-p
+ jabber-activity-personal-jids))
(jabber-activity-mode-line-update))
(defun jabber-activity-add (from buffer text proposed-alert)
"Add a JID to mode line when `jabber-activity-show-p'"
(when (funcall jabber-activity-show-p from)
(add-to-list 'jabber-activity-jids from)
- (jabber-activity-mode-line-update nil text)))
+ (add-to-list 'jabber-activity-personal-jids from)
+ (jabber-activity-mode-line-update)))
(defun jabber-activity-add-muc (nick group buffer text proposed-alert)
"Add a JID to mode line when `jabber-activity-show-p'"
(when (funcall jabber-activity-show-p group)
(add-to-list 'jabber-activity-jids group)
+ (when (jabber-muc-looks-like-personal-p text group)
+ (add-to-list 'jabber-activity-personal-jids group))
(jabber-activity-mode-line-update group text)))
(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 nil nil t)))
+ (add-to-list 'jabber-activity-personal-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
-----------------------------------------------------------------------
Summary of changes:
jabber-activity.el | 26 ++++++++++++++++----------
1 files changed, 16 insertions(+), 10 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2014-01-22 21:28:51
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 85b8468f5e4659ca2515a60cd5219aac6dba94fd (commit)
via 0adb2a8b396c90758f101d630d4ff064ac51a2f1 (commit)
from 818c52e7db386c77a5b857ea1d2253f5ab26350f (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 85b8468f5e4659ca2515a60cd5219aac6dba94fd
Author: Magnus Henoch <mag...@gm...>
Date: Wed Jan 22 21:27:50 2014 +0000
Run jabber-post-connect-hooks even if initial roster retrieval fails
diff --git a/jabber-core.el b/jabber-core.el
index 7b7386b..b3acc31 100644
--- a/jabber-core.el
+++ b/jabber-core.el
@@ -721,7 +721,7 @@ With double prefix argument, specify more connection details."
"get"
'(query ((xmlns . "jabber:iq:roster")))
#'jabber-process-roster 'initial
- #'jabber-report-success "Roster retrieval")
+ #'jabber-initial-roster-failure nil)
(list (plist-put state-data :ever-session-established t) nil))
(defvar jabber-pending-presence-timeout 0.5
diff --git a/jabber-presence.el b/jabber-presence.el
index 7fa9b19..1809abd 100644
--- a/jabber-presence.el
+++ b/jabber-presence.el
@@ -117,6 +117,13 @@ CLOSURE-DATA should be 'initial if initial roster push, nil otherwise."
(when (eq closure-data 'initial)
(run-hook-with-args 'jabber-post-connect-hooks jc)))
+(defun jabber-initial-roster-failure (jc xml-data _closure-data)
+ ;; If the initial roster request fails, let's report it, but run
+ ;; jabber-post-connect-hooks anyway. According to the spec, there
+ ;; is nothing exceptional about the server not returning a roster.
+ (jabber-report-success jc xml-data "Initial roster retrieval")
+ (run-hook-with-args 'jabber-post-connect-hooks jc))
+
(add-to-list 'jabber-presence-chain 'jabber-process-presence)
(defun jabber-process-presence (jc xml-data)
"process incoming presence tags"
commit 0adb2a8b396c90758f101d630d4ff064ac51a2f1
Author: Magnus Henoch <mag...@gm...>
Date: Wed Jan 22 10:14:41 2014 +0000
Handle urn:xmpp:delay (XEP-0203) for message timestamps
Also add `jabber-message-timestamp' in jabber-util, and simplify callers
of `jabber-x-delay'.
diff --git a/jabber-chat.el b/jabber-chat.el
index 80d214f..d08e913 100644
--- a/jabber-chat.el
+++ b/jabber-chat.el
@@ -361,7 +361,7 @@ This function is idempotent."
This function is used as an ewoc prettyprinter."
(let* ((beg (point))
(original-timestamp (when (listp (cadr data))
- (jabber-xml-path (cadr data) '(("jabber:x:delay" . "x")))))
+ (jabber-message-timestamp (cadr data))))
(internal-time
(plist-get (cddr data) :time))
(body (ignore-errors (car
@@ -376,20 +376,17 @@ This function is used as an ewoc prettyprinter."
(let ((delayed (or original-timestamp (plist-get (cddr data) :delayed))))
(case (car data)
(:local
- (jabber-chat-self-prompt (or (jabber-x-delay original-timestamp)
- internal-time)
+ (jabber-chat-self-prompt (or original-timestamp internal-time)
delayed
/me-p))
(:foreign
;; 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)
- internal-time)
+ (or original-timestamp internal-time)
delayed
/me-p))
((:error :notice :subscription-request)
- (jabber-chat-system-prompt (or (jabber-x-delay original-timestamp)
- internal-time)))
+ (jabber-chat-system-prompt (or original-timestamp internal-time)))
(:muc-local
(jabber-muc-print-prompt (cadr data) t /me-p))
(:muc-foreign
@@ -445,22 +442,21 @@ This function is used as an ewoc prettyprinter."
(not (string= (format-time-string jabber-rare-time-format time1)
(format-time-string jabber-rare-time-format time2))))
-(defun jabber-message-time (entry)
- "Return time of ENTRY, a message in internal format."
- (or (when (listp (cadr entry))
- (jabber-x-delay (jabber-xml-path (cadr entry) '(("jabber:x:delay" . "x")))))
- (plist-get (cddr entry) :time)))
-
(defun jabber-maybe-print-rare-time (node)
"Print rare time before NODE, if appropriate."
(let* ((prev (ewoc-prev jabber-chat-ewoc node))
(data (ewoc-data node))
(prev-data (when prev (ewoc-data prev))))
- (when (and jabber-print-rare-time
- (or (null prev)
- (jabber-rare-time-needed (jabber-message-time prev-data)
- (jabber-message-time data))))
- (ewoc-enter-before jabber-chat-ewoc node (list :rare-time (jabber-message-time data))))))
+ (flet ((entry-time (entry)
+ (or (when (listp (cadr entry))
+ (jabber-message-timestamp (cadr entry))
+ (plist-get (cddr entry) :time)))))
+ (when (and jabber-print-rare-time
+ (or (null prev)
+ (jabber-rare-time-needed (entry-time prev-data)
+ (entry-time data))))
+ (ewoc-enter-before jabber-chat-ewoc node
+ (list :rare-time (entry-time data)))))))
(defun jabber-chat-print-prompt (xml-data timestamp delayed dont-print-nick-p)
"Print prompt for received message in XML-DATA.
@@ -471,8 +467,7 @@ If DELAYED is true, print long timestamp
`jabber-chat-time-format').
If DONT-PRINT-NICK-P is true, don't include nickname."
(let ((from (jabber-xml-get-attribute xml-data 'from))
- (timestamp (or timestamp
- (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x)))))))
+ (timestamp (or timestamp (jabber-message-timestamp xml-data))))
(insert (jabber-propertize
(format-spec jabber-chat-foreign-prompt-format
(list
diff --git a/jabber-history.el b/jabber-history.el
index 3b2bcb0..53953b8 100644
--- a/jabber-history.el
+++ b/jabber-history.el
@@ -121,7 +121,7 @@ number after the last rotation."
(let ((from (jabber-xml-get-attribute xml-data 'from))
(text (car (jabber-xml-node-children
(car (jabber-xml-get-children xml-data 'body)))))
- (timestamp (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x))))))
+ (timestamp (jabber-message-timestamp xml-data)))
(when (and from text)
(jabber-history-log-message "in" from nil text timestamp))))))
diff --git a/jabber-muc.el b/jabber-muc.el
index e55d04e..ba713a4 100644
--- a/jabber-muc.el
+++ b/jabber-muc.el
@@ -870,7 +870,7 @@ Return nil if X-MUC is nil."
(defun jabber-muc-print-prompt (xml-data &optional local dont-print-nick-p)
"Print MUC prompt for message in XML-DATA."
(let ((nick (jabber-jid-resource (jabber-xml-get-attribute xml-data 'from)))
- (timestamp (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x))))))
+ (timestamp (jabber-message-timestamp xml-data)))
(if (stringp nick)
(insert (jabber-propertize
(format-spec jabber-groupchat-prompt-format
@@ -903,7 +903,7 @@ Return nil if X-MUC is nil."
"Print prompt for private MUC message in XML-DATA."
(let ((nick (jabber-jid-resource (jabber-xml-get-attribute xml-data 'from)))
(group (jabber-jid-user (jabber-xml-get-attribute xml-data 'from)))
- (timestamp (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x))))))
+ (timestamp (jabber-message-timestamp xml-data)))
(insert (jabber-propertize
(format-spec jabber-muc-private-foreign-prompt-format
(list
diff --git a/jabber-util.el b/jabber-util.el
index 0c867df..049eca6 100644
--- a/jabber-util.el
+++ b/jabber-util.el
@@ -408,15 +408,30 @@ The query child is often but not always <query/>."
"Return the namespace of an IQ stanza, i.e. the namespace of its query part."
(jabber-xml-get-attribute (jabber-iq-query xml-data) 'xmlns))
+(defun jabber-message-timestamp (xml-data)
+ "Given a <message/> element, return its timestamp, or nil if none."
+ (jabber-x-delay
+ (or
+ (jabber-xml-path xml-data '(("urn:xmpp:delay" . "delay")))
+ (jabber-xml-path xml-data '(("jabber:x:delay" . "x"))))))
+
(defun jabber-x-delay (xml-data)
- "Return timestamp given a <x/> tag in namespace jabber:x:delay.
+ "Return timestamp given a delayed delivery element.
+This can be either a <delay/> tag in namespace urn:xmpp:delay (XEP-0203), or
+a <x/> tag in namespace jabber:x:delay (XEP-0091).
Return nil if no such data available."
- (when (and (eq (jabber-xml-node-name xml-data) 'x)
- (string= (jabber-xml-get-attribute xml-data 'xmlns) "jabber:x:delay"))
+ (cond
+ ((and (eq (jabber-xml-node-name xml-data) 'x)
+ (string= (jabber-xml-get-attribute xml-data 'xmlns) "jabber:x:delay"))
(let ((stamp (jabber-xml-get-attribute xml-data 'stamp)))
(if (and (stringp stamp)
(= (length stamp) 17))
- (jabber-parse-legacy-time stamp)))))
+ (jabber-parse-legacy-time stamp))))
+ ((and (eq (jabber-xml-node-name xml-data) 'delay)
+ (string= (jabber-xml-get-attribute xml-data 'xmlns) "urn:xmpp:delay"))
+ (let ((stamp (jabber-xml-get-attribute xml-data 'stamp)))
+ (when (stringp stamp)
+ (jabber-parse-time stamp))))))
(defun jabber-parse-legacy-time (timestamp)
"Parse timestamp in ccyymmddThh:mm:ss format (UTC) and return as internal time value."
-----------------------------------------------------------------------
Summary of changes:
jabber-chat.el | 35 +++++++++++++++--------------------
jabber-core.el | 2 +-
jabber-history.el | 2 +-
jabber-muc.el | 4 ++--
jabber-presence.el | 7 +++++++
jabber-util.el | 23 +++++++++++++++++++----
6 files changed, 45 insertions(+), 28 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2014-01-10 15:10:55
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 818c52e7db386c77a5b857ea1d2253f5ab26350f (commit)
from dd049eb4b50424b87b77ecac907d11397eaa4071 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 818c52e7db386c77a5b857ea1d2253f5ab26350f
Author: Magnus Henoch <mag...@gm...>
Date: Fri Jan 10 15:10:45 2014 +0000
Handle {frame,icon}-title-format being t in more cases
Need to check when deactivating jabber-activity-mode as well.
diff --git a/jabber-activity.el b/jabber-activity.el
index 131835b..90bfa30 100644
--- a/jabber-activity.el
+++ b/jabber-activity.el
@@ -416,12 +416,14 @@ With a numeric arg, enable this display if arg is positive."
;; 'jabber-activity-make-name-alist)
(setq global-mode-string (delete '(t jabber-activity-mode-string)
global-mode-string))
- (setq frame-title-format
- (delete jabber-activity-count-in-title-format
- frame-title-format))
- (setq icon-title-format
- (delete jabber-activity-count-in-title-format
- icon-title-format)))))
+ (when (listp frame-title-format)
+ (setq frame-title-format
+ (delete jabber-activity-count-in-title-format
+ frame-title-format)))
+ (when (listp icon-title-format)
+ (setq icon-title-format
+ (delete jabber-activity-count-in-title-format
+ icon-title-format))))))
;; XXX: define-minor-mode should probably do this for us, but it doesn't.
(if jabber-activity-mode (jabber-activity-mode 1))
-----------------------------------------------------------------------
Summary of changes:
jabber-activity.el | 14 ++++++++------
1 files changed, 8 insertions(+), 6 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2014-01-10 14:46:49
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via dd049eb4b50424b87b77ecac907d11397eaa4071 (commit)
from 370a75193c6dbff4ded885261e196f396d05bf8c (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit dd049eb4b50424b87b77ecac907d11397eaa4071
Author: Magnus Henoch <mag...@gm...>
Date: Fri Jan 10 14:46:25 2014 +0000
Handle frame-title-format and icon-title-format being t
How has this not caused any problems before?..
diff --git a/jabber-activity.el b/jabber-activity.el
index 9f4bec9..131835b 100644
--- a/jabber-activity.el
+++ b/jabber-activity.el
@@ -387,13 +387,13 @@ With a numeric arg, enable this display if arg is positive."
;; included twice in the title. I'm not sure exactly why,
;; but it would be nice to replace the code below with
;; something cleaner.
- (if (equal (car frame-title-format) "")
+ (if (equal (car-safe frame-title-format) "")
(add-to-list 'frame-title-format
jabber-activity-count-in-title-format)
(setq frame-title-format (list ""
jabber-activity-count-in-title-format
frame-title-format)))
- (if (equal (car icon-title-format) "")
+ (if (equal (car-safe icon-title-format) "")
(add-to-list 'icon-title-format
jabber-activity-count-in-title-format)
(setq icon-title-format (list ""
-----------------------------------------------------------------------
Summary of changes:
jabber-activity.el | 4 ++--
1 files changed, 2 insertions(+), 2 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2014-01-10 09:42:13
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 370a75193c6dbff4ded885261e196f396d05bf8c (commit)
from 823411b0a3785e1a29d5df2d60b6095a1320cd3b (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 370a75193c6dbff4ded885261e196f396d05bf8c
Author: Magnus Henoch <mag...@gm...>
Date: Fri Jan 10 09:34:39 2014 +0000
Require cl in fsm.el
The `define-state-machine' macro uses `destructuring-bind' in its
expansion, and thus requires cl to be loaded while modules using
fsm.el are being compiled. This should be the safest solution.
diff --git a/fsm.el b/fsm.el
index 512cef0..1ffe941 100644
--- a/fsm.el
+++ b/fsm.el
@@ -103,7 +103,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
+;; We require cl at runtime, since we insert `destructuring-bind' into
+;; modules that use fsm.el.
+(require 'cl)
(defvar fsm-debug "*fsm-debug*"
"*Name of buffer for fsm debug messages.
-----------------------------------------------------------------------
Summary of changes:
fsm.el | 4 +++-
1 files changed, 3 insertions(+), 1 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Evgenii T. <evg...@us...> - 2014-01-09 15:02:28
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 823411b0a3785e1a29d5df2d60b6095a1320cd3b (commit)
from 482a940b2681ae91af63c8ab6d25670d4dd07393 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 823411b0a3785e1a29d5df2d60b6095a1320cd3b
Author: Evgenii Terechkov <ev...@al...>
Date: Thu Jan 9 23:01:25 2014 +0800
We need jabber-bookmarks for jabber-muc-autojoin
(via jabber-get-bookmarks and jabber-parse-conference-bookmark)
diff --git a/jabber-muc.el b/jabber-muc.el
index ceb8bc4..e55d04e 100644
--- a/jabber-muc.el
+++ b/jabber-muc.el
@@ -25,6 +25,10 @@
(require 'jabber-disco)
(require 'jabber-muc-nick-coloring)
+;; we need jabber-bookmarks for jabber-muc-autojoin (via
+;; jabber-get-bookmarks and jabber-parse-conference-bookmark):
+(require 'jabber-bookmarks)
+
(require 'cl)
;;;###autoload
-----------------------------------------------------------------------
Summary of changes:
jabber-muc.el | 4 ++++
1 files changed, 4 insertions(+), 0 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2014-01-09 01:38:31
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 482a940b2681ae91af63c8ab6d25670d4dd07393 (commit)
via 8b9fb57145d28affa77709d81ef75edf1375200c (commit)
from a4f4e0cab47112eff471bcb4d81dbb2e6bf8b320 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 482a940b2681ae91af63c8ab6d25670d4dd07393
Author: Magnus Henoch <mag...@gm...>
Date: Thu Jan 9 01:37:07 2014 +0000
Conditionally require sha1 in jabber-logon.el
I really don't understand why, but sometimes executing (require 'sha1)
from a byte-compiled file fails in Emacs 24, even though sha1 should be
provided automatically. Let's hope this fixes the problem...
diff --git a/jabber-logon.el b/jabber-logon.el
index e352e80..9f96faf 100644
--- a/jabber-logon.el
+++ b/jabber-logon.el
@@ -21,7 +21,12 @@
(require 'jabber-xml)
(require 'jabber-util)
-(require 'sha1)
+;; In Emacs 24, sha1 is built in, so this require is only needed for
+;; earlier versions. It's supposed to be a noop in Emacs 24, but
+;; sometimes, for some people, it isn't, and fails with
+;; (file-error "Cannot open load file" "sha1").
+(unless (fboundp 'sha1)
+ (require 'sha1))
(defun jabber-get-auth (jc to session-id)
"Send IQ get request in namespace \"jabber:iq:auth\"."
commit 8b9fb57145d28affa77709d81ef75edf1375200c
Author: Magnus Henoch <mag...@gm...>
Date: Thu Jan 9 01:36:15 2014 +0000
Require cl when compiling jabber-rtt.el
This is needed for setf in Emacs 24.2 and earlier.
diff --git a/jabber-rtt.el b/jabber-rtt.el
index 6d22c52..8d34850 100644
--- a/jabber-rtt.el
+++ b/jabber-rtt.el
@@ -23,6 +23,8 @@
;;; Code:
+(eval-when-compile (require 'cl))
+
;;;; Handling incoming events
;;;###autoload
-----------------------------------------------------------------------
Summary of changes:
jabber-logon.el | 7 ++++++-
jabber-rtt.el | 2 ++
2 files changed, 8 insertions(+), 1 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-30 12:26:26
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via a4f4e0cab47112eff471bcb4d81dbb2e6bf8b320 (commit)
via bb8eeb204fa7589c012dc89f2c033114e7e8579f (commit)
via 45ca35f79c1939f4aaae01127b39abca9ab1f361 (commit)
via bd570587473cf1bf36eea6b57ba8599f43b2e74c (commit)
via a5b70ebd8318999582b86794f689c2c34350f42b (commit)
via 0eb94afdee276959edb8e00b99af8bc708eeb8e3 (commit)
via f22c8656ea330c0dba4811805b0c3ec1363298f1 (commit)
via efeab97bc18e42322693852605aeaa74839b0531 (commit)
via ebce8529c30fb554b3d0df830319653445accbc8 (commit)
via 71d66edb4cedba59e98fcc43d0f1879eedac0e70 (commit)
via cf89a44b68736638763d877aef5b067adbee2986 (commit)
via b0e517f27086b27ffb522549e36b5a536ac063ff (commit)
via 3fc929628606d988e5a41cac9d5941c87a23ae26 (commit)
via 0b40a35043e7f6fb256411c2b9287b820c6d7ec1 (commit)
via 74a98f3da67f3f438889eb801ea49237a9ea1003 (commit)
via d1732df73a4c192761ba137a3a6dca1cc8128b9e (commit)
via ccd6e4a596aba77bf7ba2759068e937c01453d42 (commit)
via 2b55c4ebd07ed40f741e7c10c02d9dc253f45fd3 (commit)
from d11bda5e659ceb4d17b33ac0df78dfb6a6f27625 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a4f4e0cab47112eff471bcb4d81dbb2e6bf8b320
Merge: bb8eeb2 d11bda5
Author: Magnus Henoch <mag...@gm...>
Date: Sat Nov 30 12:25:35 2013 +0000
Merge remote-tracking branch 'refs/remotes/origin/master'
commit bb8eeb204fa7589c012dc89f2c033114e7e8579f
Author: Magnus Henoch <mag...@gm...>
Date: Sat Nov 30 12:23:06 2013 +0000
Use original JID when choosing which accounts to reconnect
Some Jabber servers (notably Facebook Chat) assign a different JID at
resource binding. This used to confuse jabber-connect-all, such that it
would establish a new connection although the existing one is perfectly
healthy.
With this change, we save the JID that we originally connected with, and
use that to avoid duplicate connections.
diff --git a/jabber-core.el b/jabber-core.el
index 32597fc..7b7386b 100644
--- a/jabber-core.el
+++ b/jabber-core.el
@@ -171,7 +171,7 @@ With many prefix arguments, one less is passed to `jabber-connect'."
arg))))
(call-interactively 'jabber-connect))
;; Only connect those accounts that are not yet connected.
- (let ((already-connected (mapcar #'jabber-connection-bare-jid jabber-connections))
+ (let ((already-connected (mapcar #'jabber-connection-original-jid jabber-connections))
(connected-one nil))
(dolist (account accounts)
(unless (member (jabber-jid-user (car account)) already-connected)
@@ -277,6 +277,8 @@ With double prefix argument, specify more connection details."
(list :connecting
(list :send-function send-function
+ ;; Save the JID we originally connected with.
+ :original-jid (concat username "@" server)
:username username
:server server
:resource resource
diff --git a/jabber-util.el b/jabber-util.el
index c4b8a97..0c867df 100644
--- a/jabber-util.el
+++ b/jabber-util.el
@@ -145,6 +145,13 @@ properties to add to the result."
(concat (plist-get sd :username) "@"
(plist-get sd :server))))
+(defun jabber-connection-original-jid (jc)
+ "Return the original JID of the given connection.
+The \"original JID\" is the JID we authenticated with. The
+server might subsequently assign us a different JID at resource
+binding."
+ (plist-get (fsm-get-state-data jc) :original-jid))
+
(defun jabber-find-connection (bare-jid)
"Find the connection to the account named by BARE-JID.
Return nil if none found."
commit 45ca35f79c1939f4aaae01127b39abca9ab1f361
Author: Magnus Henoch <mag...@gm...>
Date: Sat Nov 30 12:19:00 2013 +0000
Include JID in authentication failure message
diff --git a/jabber-sasl.el b/jabber-sasl.el
index d906933..ce3fc2e 100644
--- a/jabber-sasl.el
+++ b/jabber-sasl.el
@@ -122,7 +122,8 @@ Call REMEMBER with the password. REMEMBER is expected to return it as well."
(base64-encode-string (sasl-step-data step) t)))))
((eq (car xml-data) 'failure)
- (message "SASL authentication failure: %s"
+ (message "%s: authentication failure: %s"
+ (jabber-connection-bare-jid jc)
(jabber-xml-node-name (car (jabber-xml-node-children xml-data))))
(fsm-send jc :authentication-failure))
commit bd570587473cf1bf36eea6b57ba8599f43b2e74c
Author: Magnus Henoch <mag...@gm...>
Date: Sat Nov 30 12:18:01 2013 +0000
Suppress superfluous <active/> chat state after sending message
diff --git a/jabber-chatstates.el b/jabber-chatstates.el
index 3b8d0a5..0cdc3d1 100644
--- a/jabber-chatstates.el
+++ b/jabber-chatstates.el
@@ -72,6 +72,7 @@ nil - don't send states")
;; don't send more notifications until we know that the other
;; side wants them.
(setq jabber-chatstates-requested nil))
+ (setq jabber-chatstates-composing-sent nil)
`((active ((xmlns . ,jabber-chatstates-xmlns))))))
;;; OUTGOING
commit a5b70ebd8318999582b86794f689c2c34350f42b
Author: Magnus Henoch <mag...@gm...>
Date: Sat Nov 30 12:17:26 2013 +0000
Suppress message when writing avatar to cache
diff --git a/jabber-avatar.el b/jabber-avatar.el
index 8a956ba..e3dcbca 100644
--- a/jabber-avatar.el
+++ b/jabber-avatar.el
@@ -157,24 +157,21 @@ If there is no cached image, return nil."
(let* ((id (avatar-sha1-sum avatar))
(base64-data (avatar-base64-data avatar))
(mime-type (avatar-mime-type avatar))
- (filename (expand-file-name id jabber-avatar-cache-directory))
- (buffer (create-file-buffer filename)))
+ (filename (expand-file-name id jabber-avatar-cache-directory)))
(unless (file-directory-p jabber-avatar-cache-directory)
(make-directory jabber-avatar-cache-directory t))
(if (file-exists-p filename)
(when jabber-avatar-verbose
(message "Caching avatar, but %s already exists" filename))
- (with-current-buffer buffer
- (let ((require-final-newline nil))
- (setq buffer-file-coding-system 'binary)
+ (with-temp-buffer
+ (let ((require-final-newline nil)
+ (coding-system-for-write 'binary))
(if (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte nil))
- (set-visited-file-name filename t)
(insert base64-data)
(base64-decode-region (point-min) (point-max))
- (basic-save-buffer))))
- (kill-buffer buffer)))
+ (write-region (point-min) (point-max) filename nil 'silent))))))
;;;; Set avatar for contact
commit 0eb94afdee276959edb8e00b99af8bc708eeb8e3
Merge: b5cb0d6 f22c865
Author: Magnus Henoch <mag...@gm...>
Date: Sat Nov 30 11:13:42 2013 +0000
Merge branch 'rtt'
-----------------------------------------------------------------------
Summary of changes:
Makefile.am | 2 +-
jabber-ahc.el | 2 +-
jabber-avatar.el | 13 +-
jabber-chat.el | 10 +-
jabber-chatstates.el | 3 +-
jabber-core.el | 4 +-
jabber-disco.el | 538 +++++++++++++++++++++++++++++++++++++++++++-----
jabber-feature-neg.el | 2 +-
jabber-ft-server.el | 2 +-
jabber-muc.el | 2 +-
jabber-newdisco.el | 165 ---------------
jabber-ping.el | 2 +-
jabber-rtt.el | 319 +++++++++++++++++++++++++++++
jabber-sasl.el | 3 +-
jabber-si-server.el | 2 +-
jabber-socks5.el | 3 +-
jabber-time.el | 6 +-
jabber-util.el | 7 +
jabber-version.el | 2 +-
jabber-widget.el | 2 +-
20 files changed, 842 insertions(+), 247 deletions(-)
delete mode 100644 jabber-newdisco.el
create mode 100644 jabber-rtt.el
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-28 10:43:54
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, rtt has been updated
via f22c8656ea330c0dba4811805b0c3ec1363298f1 (commit)
from efeab97bc18e42322693852605aeaa74839b0531 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit f22c8656ea330c0dba4811805b0c3ec1363298f1
Author: Magnus Henoch <mag...@gm...>
Date: Thu Nov 28 10:41:32 2013 +0000
Ensure no duplicates in `jabber-advertised-features'
jabber-disco-advertise-features now checks whether the feature is
already listed, to avoid duplicate entries if a module is reloaded.
Duplicate entries can cause invalid Entity Capabilities entries.
diff --git a/jabber-disco.el b/jabber-disco.el
index 49cdcaa..fcb91ae 100644
--- a/jabber-disco.el
+++ b/jabber-disco.el
@@ -590,12 +590,13 @@ The value should be a key in `jabber-caps-hash-names'.")
;;;###autoload
(defun jabber-disco-advertise-feature (feature)
- (push feature jabber-advertised-features)
- (when jabber-caps-current-hash
- (jabber-caps-recalculate-hash)
- ;; If we're already connected, we need to send updated presence
- ;; for the new feature.
- (mapc #'jabber-send-current-presence jabber-connections)))
+ (unless (member feature jabber-advertised-features)
+ (push feature jabber-advertised-features)
+ (when jabber-caps-current-hash
+ (jabber-caps-recalculate-hash)
+ ;; If we're already connected, we need to send updated presence
+ ;; for the new feature.
+ (mapc #'jabber-send-current-presence jabber-connections))))
(defun jabber-caps-recalculate-hash ()
"Update `jabber-caps-current-hash' for feature list change.
-----------------------------------------------------------------------
Summary of changes:
jabber-disco.el | 13 +++++++------
1 files changed, 7 insertions(+), 6 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-27 10:31:16
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, rtt has been updated
via efeab97bc18e42322693852605aeaa74839b0531 (commit)
from ebce8529c30fb554b3d0df830319653445accbc8 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit efeab97bc18e42322693852605aeaa74839b0531
Author: Magnus Henoch <mag...@gm...>
Date: Wed Nov 27 10:30:56 2013 +0000
Fix jabber-rtt autoloads
Use `eval-after-load' to change jabber-message-chain.
Autoload jabber-rtt-send-mode.
diff --git a/jabber-rtt.el b/jabber-rtt.el
index 520ca11..6d22c52 100644
--- a/jabber-rtt.el
+++ b/jabber-rtt.el
@@ -46,7 +46,8 @@
;; Add function last in chain, so a chat buffer is already created.
;;;###autoload
-(add-to-list 'jabber-message-chain #'jabber-rtt-handle-message t)
+(eval-after-load "jabber-core"
+ '(add-to-list 'jabber-message-chain #'jabber-rtt-handle-message t))
;;;###autoload
(defun jabber-rtt-handle-message (jc xml-data)
@@ -190,6 +191,7 @@
(defvar jabber-rtt-send-last-timestamp nil)
(make-variable-buffer-local 'jabber-rtt-send-last-timestamp)
+;;;###autoload
(define-minor-mode jabber-rtt-send-mode
"Show text to recipient as it is being typed.
This lets the recipient see every change made to the message up
-----------------------------------------------------------------------
Summary of changes:
jabber-rtt.el | 4 +++-
1 files changed, 3 insertions(+), 1 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-26 20:13:31
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, rtt has been updated
via ebce8529c30fb554b3d0df830319653445accbc8 (commit)
via 71d66edb4cedba59e98fcc43d0f1879eedac0e70 (commit)
via cf89a44b68736638763d877aef5b067adbee2986 (commit)
via b0e517f27086b27ffb522549e36b5a536ac063ff (commit)
via 3fc929628606d988e5a41cac9d5941c87a23ae26 (commit)
from 0b40a35043e7f6fb256411c2b9287b820c6d7ec1 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit ebce8529c30fb554b3d0df830319653445accbc8
Author: Magnus Henoch <mag...@gm...>
Date: Tue Nov 26 20:09:48 2013 +0000
Add jabber-rtt to Makefile.am
diff --git a/Makefile.am b/Makefile.am
index fc57b22..ce47ac7 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -13,7 +13,7 @@ jabber-export.el jabber-feature-neg.el jabber-festival.el \
jabber-ft-client.el jabber-ft-common.el jabber-ft-server.el \
jabber-gmail.el jabber-history.el jabber-iq.el jabber-keepalive.el \
jabber-keymap.el jabber-logon.el jabber-menu.el jabber-modeline.el \
-jabber-muc-nick-completion.el jabber-muc.el \
+jabber-muc-nick-completion.el jabber-muc.el jabber-rtt.el \
jabber-osd.el jabber-presence.el jabber-private.el jabber-ratpoison.el \
jabber-register.el jabber-roster.el jabber-sasl.el jabber-sawfish.el \
jabber-screen.el jabber-search.el jabber-si-client.el \
commit 71d66edb4cedba59e98fcc43d0f1879eedac0e70
Author: Magnus Henoch <mag...@gm...>
Date: Tue Nov 26 20:07:56 2013 +0000
Advertise RTT feature
diff --git a/jabber-rtt.el b/jabber-rtt.el
index 65d5272..520ca11 100644
--- a/jabber-rtt.el
+++ b/jabber-rtt.el
@@ -25,6 +25,10 @@
;;;; Handling incoming events
+;;;###autoload
+(eval-after-load "jabber-disco"
+ '(jabber-disco-advertise-feature "urn:xmpp:rtt:0"))
+
(defvar jabber-rtt-ewoc-node nil)
(make-variable-buffer-local 'jabber-rtt-ewoc-node)
commit cf89a44b68736638763d877aef5b067adbee2986
Author: Magnus Henoch <mag...@gm...>
Date: Tue Nov 26 01:18:06 2013 +0000
Send Entity Capabilities in outgoing presence stanzas
Also changed the disco info feature "plugin" system - now a module that
wants to advertise a feature needs to call the function
`jabber-disco-advertise-feature'. This ensures that caps are
recalculated as needed.
diff --git a/jabber-ahc.el b/jabber-ahc.el
index e201b7d..605c0f8 100644
--- a/jabber-ahc.el
+++ b/jabber-ahc.el
@@ -75,7 +75,7 @@ access allowed. nil means open for everyone."
(feature ((var . "http://jabber.org/protocol/disco#info")))
(feature ((var . "jabber:x:data")))))))
-(add-to-list 'jabber-advertised-features "http://jabber.org/protocol/commands")
+(jabber-disco-advertise-feature "http://jabber.org/protocol/commands")
(add-to-list 'jabber-disco-items-nodes
(list "http://jabber.org/protocol/commands" #'jabber-ahc-disco-items nil))
(defun jabber-ahc-disco-items (jc xml-data)
diff --git a/jabber-chatstates.el b/jabber-chatstates.el
index 8b82171..3b8d0a5 100644
--- a/jabber-chatstates.el
+++ b/jabber-chatstates.el
@@ -168,7 +168,7 @@ It can be sent and cancelled several times.")
;; Add function last in chain, so a chat buffer is already created.
(add-to-list 'jabber-message-chain 'jabber-handle-incoming-message-chatstates t)
-(add-to-list 'jabber-advertised-features "http://jabber.org/protocol/chatstates")
+(jabber-disco-advertise-feature "http://jabber.org/protocol/chatstates")
(provide 'jabber-chatstates)
;; arch-tag: d879de90-51e1-11dc-909d-000a95c2fcd0
diff --git a/jabber-disco.el b/jabber-disco.el
index 6eb3667..49cdcaa 100644
--- a/jabber-disco.el
+++ b/jabber-disco.el
@@ -25,10 +25,12 @@
;;; Respond to disco requests
-;; Advertise your features here. Add the namespace to this list.
(defvar jabber-advertised-features
(list "http://jabber.org/protocol/disco#info")
- "Features advertised on service discovery requests")
+ "Features advertised on service discovery requests
+
+Don't add your feature to this list directly. Instead, call
+`jabber-disco-advertise-feature'.")
(defvar jabber-disco-items-nodes
(list
@@ -109,7 +111,7 @@ See JEP-0030."
;; No such node
(jabber-signal-error "cancel" 'item-not-found))))
-(defun jabber-disco-return-client-info (jc xml-data)
+(defun jabber-disco-return-client-info (&optional jc xml-data)
`(
;; If running under a window system, this is
;; a GUI client. If not, it is a console client.
@@ -482,6 +484,8 @@ Return (IDENTITIES FEATURES), or nil if not in cache."
;; No, forget about it for now.
(remhash key jabber-caps-cache))))))
+;;; Entity Capabilities utility functions
+
(defun jabber-caps-ver-string (query hash)
;; XEP-0115, section 5.1
;; 1. Initialize an empty string S.
@@ -573,6 +577,58 @@ Return (IDENTITIES FEATURES), or nil if not in cache."
(b-xml:lang (jabber-xml-get-attribute b 'xml:lang)))
(string< a-xml:lang b-xml:lang)))))))))
+;;; Sending Entity Capabilities
+
+(defvar jabber-caps-default-hash-function "sha-1"
+ "Hash function to use when sending caps in presence stanzas.
+The value should be a key in `jabber-caps-hash-names'.")
+
+(defvar jabber-caps-current-hash nil
+ "The current disco hash we're sending out in presence stanzas.")
+
+(defconst jabber-caps-node "http://emacs-jabber.sourceforge.net")
+
+;;;###autoload
+(defun jabber-disco-advertise-feature (feature)
+ (push feature jabber-advertised-features)
+ (when jabber-caps-current-hash
+ (jabber-caps-recalculate-hash)
+ ;; If we're already connected, we need to send updated presence
+ ;; for the new feature.
+ (mapc #'jabber-send-current-presence jabber-connections)))
+
+(defun jabber-caps-recalculate-hash ()
+ "Update `jabber-caps-current-hash' for feature list change.
+Also update `jabber-disco-info-nodes', so we return results for
+the right node."
+ (let* ((old-hash jabber-caps-current-hash)
+ (old-node (and old-hash (concat jabber-caps-node "#" old-hash)))
+ (new-hash
+ (jabber-caps-ver-string `(query () ,@(jabber-disco-return-client-info))
+ jabber-caps-default-hash-function))
+ (new-node (concat jabber-caps-node "#" new-hash)))
+ (when old-node
+ (let ((old-entry (assoc old-node jabber-disco-info-nodes)))
+ (when old-entry
+ (setq jabber-disco-info-nodes (delq old-entry jabber-disco-info-nodes)))))
+ (push (list new-node #'jabber-disco-return-client-info nil)
+ jabber-disco-info-nodes)
+ (setq jabber-caps-current-hash new-hash)))
+
+;;;###autoload
+(defun jabber-caps-presence-element (_jc)
+ (unless jabber-caps-current-hash
+ (jabber-caps-recalculate-hash))
+
+ (list
+ `(c ((xmlns . "http://jabber.org/protocol/caps")
+ (hash . ,jabber-caps-default-hash-function)
+ (node . ,jabber-caps-node)
+ (ver . ,jabber-caps-current-hash)))))
+
+;;;###autoload
+(eval-after-load "jabber-presence"
+ '(add-to-list 'jabber-presence-element-functions #'jabber-caps-presence-element))
(provide 'jabber-disco)
diff --git a/jabber-feature-neg.el b/jabber-feature-neg.el
index 1fb8853..748a4cd 100644
--- a/jabber-feature-neg.el
+++ b/jabber-feature-neg.el
@@ -22,7 +22,7 @@
(require 'jabber-disco)
(require 'cl)
-(add-to-list 'jabber-advertised-features "http://jabber.org/protocol/feature-neg")
+(jabber-disco-advertise-feature "http://jabber.org/protocol/feature-neg")
(defun jabber-fn-parse (xml-data type)
"Parse a Feature Negotiation request, return alist representation.
diff --git a/jabber-ft-server.el b/jabber-ft-server.el
index cd889d5..b2afceb 100644
--- a/jabber-ft-server.el
+++ b/jabber-ft-server.el
@@ -31,7 +31,7 @@
(defvar jabber-ft-md5-hash nil
"MD5 hash of the file that is being downloaded")
-(add-to-list 'jabber-advertised-features "http://jabber.org/protocol/si/profile/file-transfer")
+(jabber-disco-advertise-feature "http://jabber.org/protocol/si/profile/file-transfer")
(add-to-list 'jabber-si-profiles
(list "http://jabber.org/protocol/si/profile/file-transfer"
diff --git a/jabber-ping.el b/jabber-ping.el
index e71267e..e9056ab 100644
--- a/jabber-ping.el
+++ b/jabber-ping.el
@@ -49,7 +49,7 @@
(format "%s is alive" to)))
(add-to-list 'jabber-iq-get-xmlns-alist (cons "urn:xmpp:ping" 'jabber-pong))
-(add-to-list 'jabber-advertised-features "urn:xmpp:ping")
+(jabber-disco-advertise-feature "urn:xmpp:ping")
(defun jabber-pong (jc xml-data)
"Return pong as defined in XEP-0199. Sender and Id are
diff --git a/jabber-si-server.el b/jabber-si-server.el
index 286ad29..70b99ad 100644
--- a/jabber-si-server.el
+++ b/jabber-si-server.el
@@ -25,7 +25,7 @@
(require 'jabber-si-common)
-(add-to-list 'jabber-advertised-features "http://jabber.org/protocol/si")
+(jabber-disco-advertise-feature "http://jabber.org/protocol/si")
;; Now, stream methods push data to profiles. It could be the other
;; way around; not sure which is better.
diff --git a/jabber-socks5.el b/jabber-socks5.el
index 54e6a90..fc77523 100644
--- a/jabber-socks5.el
+++ b/jabber-socks5.el
@@ -57,7 +57,7 @@ Put preferred ones first."
Keys of the alist are strings, the JIDs of the proxies.
Values are \"streamhost\" XML nodes.")
-(add-to-list 'jabber-advertised-features "http://jabber.org/protocol/bytestreams")
+(jabber-disco-advertise-feature "http://jabber.org/protocol/bytestreams")
(add-to-list 'jabber-si-stream-methods
(list "http://jabber.org/protocol/bytestreams"
diff --git a/jabber-time.el b/jabber-time.el
index 919e5b0..96ebe36 100644
--- a/jabber-time.el
+++ b/jabber-time.el
@@ -147,7 +147,7 @@
(format "%s uptime: %s seconds" from seconds)))))
(add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:time" 'jabber-return-legacy-time))
-(add-to-list 'jabber-advertised-features "jabber:iq:time")
+(jabber-disco-advertise-feature "jabber:iq:time")
(defun jabber-return-legacy-time (jc xml-data)
"Return client time as defined in XEP-0090. Sender and ID are
@@ -165,7 +165,7 @@ determined from the incoming packet passed in XML-DATA."
id)))
(add-to-list 'jabber-iq-get-xmlns-alist (cons "urn:xmpp:time" 'jabber-return-time))
-(add-to-list 'jabber-advertised-features "urn:xmpp:time")
+(jabber-disco-advertise-feature "urn:xmpp:time")
(defun jabber-return-time (jc xml-data)
"Return client time as defined in XEP-0202. Sender and ID are
@@ -180,7 +180,7 @@ determined from the incoming packet passed in XML-DATA."
id)))
(add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:last" 'jabber-return-last))
-(add-to-list 'jabber-advertised-features "jabber:iq:last")
+(jabber-disco-advertise-feature "jabber:iq:last")
(defun jabber-return-last (jc xml-data)
(let ((to (jabber-xml-get-attribute xml-data 'from))
diff --git a/jabber-version.el b/jabber-version.el
index 91d6ff3..455701a 100644
--- a/jabber-version.el
+++ b/jabber-version.el
@@ -54,7 +54,7 @@
(if jabber-version-show
(and
(add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:version" 'jabber-return-version))
- (add-to-list 'jabber-advertised-features "jabber:iq:version")))
+ (jabber-disco-advertise-feature "jabber:iq:version")))
(defun jabber-return-version (jc xml-data)
"Return client version as defined in JEP-0092. Sender and ID are
diff --git a/jabber-widget.el b/jabber-widget.el
index 9c31baf..8e8fd0b 100644
--- a/jabber-widget.el
+++ b/jabber-widget.el
@@ -35,7 +35,7 @@
(defvar jabber-submit-to nil
"JID of the entity to which form data is to be sent")
-(add-to-list 'jabber-advertised-features "jabber:x:data")
+(jabber-disco-advertise-feature "jabber:x:data")
(define-widget 'jid 'string
"JID widget."
commit b0e517f27086b27ffb522549e36b5a536ac063ff
Author: Magnus Henoch <mag...@gm...>
Date: Tue Nov 26 01:13:44 2013 +0000
Look for caps only on "available" presence
diff --git a/jabber-disco.el b/jabber-disco.el
index 2d9f132..6eb3667 100644
--- a/jabber-disco.el
+++ b/jabber-disco.el
@@ -386,8 +386,9 @@ Return (IDENTITIES FEATURES), or nil if not in cache."
(defun jabber-process-caps (jc xml-data)
"Look for entity capabilities in presence stanzas."
(let* ((from (jabber-xml-get-attribute xml-data 'from))
+ (type (jabber-xml-get-attribute xml-data 'type))
(c (jabber-xml-path xml-data '(("http://jabber.org/protocol/caps" . "c")))))
- (when c
+ (when (and (null type) c)
(jabber-xml-let-attributes
(ext hash node ver) c
(cond
commit 3fc929628606d988e5a41cac9d5941c87a23ae26
Author: Magnus Henoch <mag...@gm...>
Date: Mon Nov 25 23:36:12 2013 +0000
Merge jabber-newdisco into jabber-disco
The functionality is about to start overlapping. Also, there wasn't
much sense in separating the two to begin with.
diff --git a/Makefile.am b/Makefile.am
index bf9bd01..fc57b22 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -13,7 +13,7 @@ jabber-export.el jabber-feature-neg.el jabber-festival.el \
jabber-ft-client.el jabber-ft-common.el jabber-ft-server.el \
jabber-gmail.el jabber-history.el jabber-iq.el jabber-keepalive.el \
jabber-keymap.el jabber-logon.el jabber-menu.el jabber-modeline.el \
-jabber-muc-nick-completion.el jabber-muc.el jabber-newdisco.el \
+jabber-muc-nick-completion.el jabber-muc.el \
jabber-osd.el jabber-presence.el jabber-private.el jabber-ratpoison.el \
jabber-register.el jabber-roster.el jabber-sasl.el jabber-sawfish.el \
jabber-screen.el jabber-search.el jabber-si-client.el \
diff --git a/jabber-disco.el b/jabber-disco.el
index 38cb213..2d9f132 100644
--- a/jabber-disco.el
+++ b/jabber-disco.el
@@ -19,16 +19,12 @@
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-;;; All the client part should be seriously rewritten, or at least
-;;; reconsidered. I'm imagining a separation between backend and
-;;; frontend, so that various functions can perform disco queries for
-;;; their own purposes, and maybe some caching with that.
-
(require 'jabber-iq)
(require 'jabber-xml)
(require 'jabber-menu)
+;;; Respond to disco requests
+
;; Advertise your features here. Add the namespace to this list.
(defvar jabber-advertised-features
(list "http://jabber.org/protocol/disco#info")
@@ -75,53 +71,6 @@ Second item is access control function. That function is passed the
JID, and returns non-nil if access is granted. If the second item is
nil, access is always granted.")
-(defun jabber-process-disco-info (jc xml-data)
- "Handle results from info disco requests."
-
- (let ((beginning (point)))
- (dolist (x (jabber-xml-node-children (jabber-iq-query xml-data)))
- (cond
- ((eq (jabber-xml-node-name x) 'identity)
- (let ((name (jabber-xml-get-attribute x 'name))
- (category (jabber-xml-get-attribute x 'category))
- (type (jabber-xml-get-attribute x 'type)))
- (insert (jabber-propertize (if name
- name
- "Unnamed")
- 'face 'jabber-title-medium)
- "\n\nCategory:\t" category "\n")
- (if type
- (insert "Type:\t\t" type "\n"))
- (insert "\n")))
- ((eq (jabber-xml-node-name x) 'feature)
- (let ((var (jabber-xml-get-attribute x 'var)))
- (insert "Feature:\t" var "\n")))))
- (put-text-property beginning (point)
- 'jabber-jid (jabber-xml-get-attribute xml-data 'from))
- (put-text-property beginning (point)
- 'jabber-account jc)))
-
-(defun jabber-process-disco-items (jc xml-data)
- "Handle results from items disco requests."
-
- (let ((items (jabber-xml-get-children (jabber-iq-query xml-data) 'item)))
- (if items
- (dolist (item items)
- (let ((jid (jabber-xml-get-attribute item 'jid))
- (name (jabber-xml-get-attribute item 'name))
- (node (jabber-xml-get-attribute item 'node)))
- (insert
- (jabber-propertize
- (concat
- (jabber-propertize
- (concat jid "\n" (if node (format "Node: %s\n" node)))
- 'face 'jabber-title-medium)
- name "\n\n")
- 'jabber-jid jid
- 'jabber-account jc
- 'jabber-node node))))
- (insert "No items found.\n"))))
-
(add-to-list 'jabber-iq-get-xmlns-alist
(cons "http://jabber.org/protocol/disco#info" 'jabber-return-disco-info))
(add-to-list 'jabber-iq-get-xmlns-alist
@@ -174,6 +123,8 @@ See JEP-0030."
#'(lambda (featurename)
`(feature ((var . ,featurename))))
jabber-advertised-features)))
+
+;;; Interactive disco requests
(add-to-list 'jabber-jid-info-menu
(cons "Send items disco query" 'jabber-get-disco-items))
@@ -205,6 +156,423 @@ See JEP-0030."
#'jabber-process-data #'jabber-process-disco-info
#'jabber-process-data "Info discovery failed"))
+(defun jabber-process-disco-info (jc xml-data)
+ "Handle results from info disco requests."
+
+ (let ((beginning (point)))
+ (dolist (x (jabber-xml-node-children (jabber-iq-query xml-data)))
+ (cond
+ ((eq (jabber-xml-node-name x) 'identity)
+ (let ((name (jabber-xml-get-attribute x 'name))
+ (category (jabber-xml-get-attribute x 'category))
+ (type (jabber-xml-get-attribute x 'type)))
+ (insert (jabber-propertize (if name
+ name
+ "Unnamed")
+ 'face 'jabber-title-medium)
+ "\n\nCategory:\t" category "\n")
+ (if type
+ (insert "Type:\t\t" type "\n"))
+ (insert "\n")))
+ ((eq (jabber-xml-node-name x) 'feature)
+ (let ((var (jabber-xml-get-attribute x 'var)))
+ (insert "Feature:\t" var "\n")))))
+ (put-text-property beginning (point)
+ 'jabber-jid (jabber-xml-get-attribute xml-data 'from))
+ (put-text-property beginning (point)
+ 'jabber-account jc)))
+
+(defun jabber-process-disco-items (jc xml-data)
+ "Handle results from items disco requests."
+
+ (let ((items (jabber-xml-get-children (jabber-iq-query xml-data) 'item)))
+ (if items
+ (dolist (item items)
+ (let ((jid (jabber-xml-get-attribute item 'jid))
+ (name (jabber-xml-get-attribute item 'name))
+ (node (jabber-xml-get-attribute item 'node)))
+ (insert
+ (jabber-propertize
+ (concat
+ (jabber-propertize
+ (concat jid "\n" (if node (format "Node: %s\n" node)))
+ 'face 'jabber-title-medium)
+ name "\n\n")
+ 'jabber-jid jid
+ 'jabber-account jc
+ 'jabber-node node))))
+ (insert "No items found.\n"))))
+
+;;; Caching API for disco requests
+
+;; Keys are ("jid" . "node"), where "node" is nil if appropriate.
+;; Values are (identities features), where each identity is ["name"
+;; "category" "type"], and each feature is a string.
+(defvar jabber-disco-info-cache (make-hash-table :test 'equal))
+
+;; Keys are ("jid" . "node"). Values are (items), where each
+;; item is ["name" "jid" "node"] (some values may be nil).
+(defvar jabber-disco-items-cache (make-hash-table :test 'equal))
+
+(defun jabber-disco-get-info (jc jid node callback closure-data &optional force)
+ "Get disco info for JID and NODE, using connection JC.
+Call CALLBACK with JC and CLOSURE-DATA as first and second
+arguments and result as third argument when result is available.
+On success, result is (IDENTITIES FEATURES), where each identity is [\"name\"
+\"category\" \"type\"], and each feature is a string.
+On error, result is the error node, recognizable by (eq (car result) 'error).
+
+If CALLBACK is nil, just fetch data. If FORCE is non-nil,
+invalidate cache and get fresh data."
+ (when force
+ (remhash (cons jid node) jabber-disco-info-cache))
+ (let ((result (unless force (jabber-disco-get-info-immediately jid node))))
+ (if result
+ (and callback (run-with-timer 0 nil callback jc closure-data result))
+ (jabber-send-iq jc jid
+ "get"
+ `(query ((xmlns . "http://jabber.org/protocol/disco#info")
+ ,@(when node `((node . ,node)))))
+ #'jabber-disco-got-info (cons callback closure-data)
+ (lambda (jc xml-data callback-data)
+ (when (car callback-data)
+ (funcall (car callback-data) jc (cdr callback-data) (jabber-iq-error xml-data))))
+ (cons callback closure-data)))))
+
+(defun jabber-disco-got-info (jc xml-data callback-data)
+ (let ((jid (jabber-xml-get-attribute xml-data 'from))
+ (node (jabber-xml-get-attribute (jabber-iq-query xml-data)
+ 'node))
+ (result (jabber-disco-parse-info xml-data)))
+ (puthash (cons jid node) result jabber-disco-info-cache)
+ (when (car callback-data)
+ (funcall (car callback-data) jc (cdr callback-data) result))))
+
+(defun jabber-disco-parse-info (xml-data)
+ "Extract data from an <iq/> stanza containing a disco#info result.
+See `jabber-disco-get-info' for a description of the return value."
+ (list
+ (mapcar
+ #'(lambda (id)
+ (vector (jabber-xml-get-attribute id 'name)
+ (jabber-xml-get-attribute id 'category)
+ (jabber-xml-get-attribute id 'type)))
+ (jabber-xml-get-children (jabber-iq-query xml-data) 'identity))
+ (mapcar
+ #'(lambda (feature)
+ (jabber-xml-get-attribute feature 'var))
+ (jabber-xml-get-children (jabber-iq-query xml-data) 'feature))))
+
+(defun jabber-disco-get-info-immediately (jid node)
+ "Get cached disco info for JID and NODE.
+Return nil if no info available.
+
+Fill the cache with `jabber-disco-get-info'."
+ (or
+ ;; Check "normal" cache...
+ (gethash (cons jid node) jabber-disco-info-cache)
+ ;; And then check Entity Capabilities.
+ (and (null node) (jabber-caps-get-cached jid))))
+
+(defun jabber-disco-get-items (jc jid node callback closure-data &optional force)
+ "Get disco items for JID and NODE, using connection JC.
+Call CALLBACK with JC and CLOSURE-DATA as first and second
+arguments and items result as third argument when result is
+available.
+On success, result is a list of items, where each
+item is [\"name\" \"jid\" \"node\"] (some values may be nil).
+On error, result is the error node, recognizable by (eq (car result) 'error).
+
+If CALLBACK is nil, just fetch data. If FORCE is non-nil,
+invalidate cache and get fresh data."
+ (when force
+ (remhash (cons jid node) jabber-disco-items-cache))
+ (let ((result (gethash (cons jid node) jabber-disco-items-cache)))
+ (if result
+ (and callback (run-with-timer 0 nil callback jc closure-data result))
+ (jabber-send-iq jc jid
+ "get"
+ `(query ((xmlns . "http://jabber.org/protocol/disco#items")
+ ,@(when node `((node . ,node)))))
+ #'jabber-disco-got-items (cons callback closure-data)
+ (lambda (jc xml-data callback-data)
+ (when (car callback-data)
+ (funcall (car callback-data) jc (cdr callback-data) (jabber-iq-error xml-data))))
+ (cons callback closure-data)))))
+
+(defun jabber-disco-got-items (jc xml-data callback-data)
+ (let ((jid (jabber-xml-get-attribute xml-data 'from))
+ (node (jabber-xml-get-attribute (jabber-iq-query xml-data)
+ 'node))
+ (result
+ (mapcar
+ #'(lambda (item)
+ (vector
+ (jabber-xml-get-attribute item 'name)
+ (jabber-xml-get-attribute item 'jid)
+ (jabber-xml-get-attribute item 'node)))
+ (jabber-xml-get-children (jabber-iq-query xml-data) 'item))))
+ (puthash (cons jid node) result jabber-disco-items-cache)
+ (when (car callback-data)
+ (funcall (car callback-data) jc (cdr callback-data) result))))
+
+(defun jabber-disco-get-items-immediately (jid node)
+ (gethash (cons jid node) jabber-disco-items-cache))
+
+;;; Publish
+
+(defun jabber-disco-publish (jc node item-name item-jid item-node)
+ "Publish the given item under disco node NODE."
+ (jabber-send-iq jc nil
+ "set"
+ `(query ((xmlns . "http://jabber.org/protocol/disco#items")
+ ,@(when node `((node . ,node))))
+ (item ((action . "update")
+ (jid . ,item-jid)
+ ,@(when item-name
+ `((name . ,item-name)))
+ ,@(when item-node
+ `((node . ,item-node))))))
+ 'jabber-report-success "Disco publish"
+ 'jabber-report-success "Disco publish"))
+
+(defun jabber-disco-publish-remove (jc node item-jid item-node)
+ "Remove the given item from published disco items."
+ (jabber-send-iq jc nil
+ "set"
+ `(query ((xmlns . "http://jabber.org/protocol/disco#items")
+ ,@(when node `((node . ,node))))
+ (item ((action . "remove")
+ (jid . ,item-jid)
+ ,@(when item-node
+ `((node . ,item-node))))))
+ 'jabber-report-success "Disco removal"
+ 'jabber-report-success "Disco removal"))
+
+;;; Entity Capabilities (XEP-0115)
+
+;;;###autoload
+(eval-after-load "jabber-core"
+ '(add-to-list 'jabber-presence-chain #'jabber-process-caps))
+
+(defvar jabber-caps-cache (make-hash-table :test 'equal))
+
+(defconst jabber-caps-hash-names
+ '(("sha-1" . sha1)
+ ("sha-224" . sha224)
+ ("sha-256" . sha256)
+ ("sha-384" . sha384)
+ ("sha-512" . sha512))
+ "Hash function name map.
+Maps names defined in http://www.iana.org/assignments/hash-function-text-names
+to symbols accepted by `secure-hash'.
+
+XEP-0115 currently recommends SHA-1, but let's be future-proof.")
+
+(defun jabber-caps-get-cached (jid)
+ "Get disco info from Entity Capabilities cache.
+JID should be a string containing a full JID.
+Return (IDENTITIES FEATURES), or nil if not in cache."
+ (let* ((symbol (jabber-jid-symbol jid))
+ (resource (or (jabber-jid-resource jid) ""))
+ (resource-plist (cdr (assoc resource (get symbol 'resources))))
+ (key (plist-get resource-plist 'caps)))
+ (when key
+ (let ((cache-entry (gethash key jabber-caps-cache)))
+ (when (and (consp cache-entry) (not (floatp (car cache-entry))))
+ cache-entry)))))
+
+;;;###autoload
+(defun jabber-process-caps (jc xml-data)
+ "Look for entity capabilities in presence stanzas."
+ (let* ((from (jabber-xml-get-attribute xml-data 'from))
+ (c (jabber-xml-path xml-data '(("http://jabber.org/protocol/caps" . "c")))))
+ (when c
+ (jabber-xml-let-attributes
+ (ext hash node ver) c
+ (cond
+ (hash
+ ;; If the <c/> element has a hash attribute, it follows the
+ ;; "modern" version of XEP-0115.
+ (jabber-process-caps-modern jc from hash node ver))
+ (t
+ ;; No hash attribute. Use legacy version of XEP-0115.
+ ;; TODO: do something clever here.
+ ))))))
+
+(defun jabber-process-caps-modern (jc jid hash node ver)
+ (when (assoc hash jabber-caps-hash-names)
+ ;; We support the hash function used.
+ (let* ((key (cons hash ver))
+ (cache-entry (gethash key jabber-caps-cache)))
+ ;; Remember the hash in the JID symbol.
+ (let* ((symbol (jabber-jid-symbol jid))
+ (resource (or (jabber-jid-resource jid) ""))
+ (resource-entry (assoc resource (get symbol 'resources)))
+ (new-resource-plist (plist-put (cdr resource-entry) 'caps key)))
+ (if resource-entry
+ (setf (cdr resource-entry) new-resource-plist)
+ (push (cons resource new-resource-plist) (get symbol 'resources))))
+
+ (flet ((request-disco-info
+ ()
+ (jabber-send-iq
+ jc jid
+ "get"
+ `(query ((xmlns . "http://jabber.org/protocol/disco#info")
+ (node . ,(concat node "#" ver))))
+ #'jabber-process-caps-info-result (list hash node ver)
+ #'jabber-process-caps-info-error (list hash node ver))))
+ (cond
+ ((and (consp cache-entry)
+ (floatp (car cache-entry)))
+ ;; We have a record of asking someone about this hash.
+ (if (< (- (float-time) (car cache-entry)) 10.0)
+ ;; We asked someone about this hash less than 10 seconds ago.
+ ;; Let's add the new JID to the entry, just in case that
+ ;; doesn't work out.
+ (pushnew jid (cdr cache-entry) :test #'string=)
+ ;; We asked someone about it more than 10 seconds ago.
+ ;; They're probably not going to answer. Let's ask
+ ;; this contact about it instead.
+ (setf (car cache-entry) (float-time))
+ (request-disco-info)))
+ ((null cache-entry)
+ ;; We know nothing about this hash. Let's note the
+ ;; fact that we tried to get information about it.
+ (puthash key (list (float-time)) jabber-caps-cache)
+ (request-disco-info))
+ (t
+ ;; We already know what this hash represents, so we
+ ;; can cache info for this contact.
+ (puthash (cons jid nil) cache-entry jabber-disco-info-cache)))))))
+
+(defun jabber-process-caps-info-result (jc xml-data closure-data)
+ (destructuring-bind (hash node ver) closure-data
+ (let* ((key (cons hash ver))
+ (query (jabber-iq-query xml-data))
+ (verification-string (jabber-caps-ver-string query hash)))
+ (if (string= ver verification-string)
+ ;; The hash is correct; save info.
+ (puthash key (jabber-disco-parse-info xml-data) jabber-caps-cache)
+ ;; The hash is incorrect.
+ (jabber-caps-try-next jc hash node ver)))))
+
+(defun jabber-process-caps-info-error (jc xml-data closure-data)
+ (destructuring-bind (hash node ver) closure-data
+ (jabber-caps-try-next jc hash node ver)))
+
+(defun jabber-caps-try-next (jc hash node ver)
+ (let* ((key (cons hash ver))
+ (cache-entry (gethash key jabber-caps-cache)))
+ (when (floatp (car-safe cache-entry))
+ (let ((next-jid (pop (cdr cache-entry))))
+ ;; Do we know someone else we could ask about this hash?
+ (if next-jid
+ (progn
+ (setf (car cache-entry) (float-time))
+ (jabber-send-iq
+ jc next-jid
+ "get"
+ `(query ((xmlns . "http://jabber.org/protocol/disco#info")
+ (node . ,(concat node "#" ver))))
+ #'jabber-process-caps-info-result key
+ #'jabber-process-caps-info-error key))
+ ;; No, forget about it for now.
+ (remhash key jabber-caps-cache))))))
+
+(defun jabber-caps-ver-string (query hash)
+ ;; XEP-0115, section 5.1
+ ;; 1. Initialize an empty string S.
+ (with-temp-buffer
+ (let* ((identities (jabber-xml-get-children query 'identity))
+ (features (mapcar (lambda (feature) (jabber-xml-get-attribute feature 'var))
+ (jabber-xml-get-children query 'feature)))
+ (maybe-forms (jabber-xml-get-children query 'x))
+ (forms (remove-if-not
+ (lambda (x)
+ ;; Keep elements that are forms and have a FORM_TYPE,
+ ;; according to XEP-0128.
+ (and (string= (jabber-xml-get-xmlns x) "jabber:x:data")
+ (jabber-xdata-formtype x)))
+ maybe-forms)))
+ ;; 2. Sort the service discovery identities [15] by category
+ ;; and then by type and then by xml:lang (if it exists),
+ ;; formatted as CATEGORY '/' [TYPE] '/' [LANG] '/'
+ ;; [NAME]. [16] Note that each slash is included even if the
+ ;; LANG or NAME is not included (in accordance with XEP-0030,
+ ;; the category and type MUST be included.
+ (setq identities (sort identities #'jabber-caps-identity-<))
+ ;; 3. For each identity, append the 'category/type/lang/name' to
+ ;; S, followed by the '<' character.
+ (dolist (identity identities)
+ (jabber-xml-let-attributes (category type xml:lang name) identity
+ ;; Use `concat' here instead of passing everything to
+ ;; `insert', since `concat' tolerates nil values.
+ (insert (concat category "/" type "/" xml:lang "/" name "<"))))
+ ;; 4. Sort the supported service discovery features. [17]
+ (setq features (sort features #'string<))
+ ;; 5. For each feature, append the feature to S, followed by the
+ ;; '<' character.
+ (dolist (feature features)
+ (insert feature "<"))
+ ;; 6. If the service discovery information response includes
+ ;; XEP-0128 data forms, sort the forms by the FORM_TYPE (i.e.,
+ ;; by the XML character data of the <value/> element).
+ (setq forms (sort forms (lambda (a b)
+ (string< (jabber-xdata-formtype a)
+ (jabber-xdata-formtype b)))))
+ ;; 7. For each extended service discovery information form:
+ (dolist (form forms)
+ ;; Append the XML character data of the FORM_TYPE field's
+ ;; <value/> element, followed by the '<' character.
+ (insert (jabber-xdata-formtype form) "<")
+ ;; Sort the fields by the value of the "var" attribute.
+ (let ((fields (sort (jabber-xml-get-children form 'field)
+ (lambda (a b)
+ (string< (jabber-xml-get-attribute a 'var)
+ (jabber-xml-get-attribute b 'var))))))
+ (dolist (field fields)
+ ;; For each field other than FORM_TYPE:
+ (unless (string= (jabber-xml-get-attribute field 'var) "FORM_TYPE")
+ ;; Append the value of the "var" attribute, followed by the '<' character.
+ (insert (jabber-xml-get-attribute field 'var) "<")
+ ;; Sort values by the XML character data of the <value/> element.
+ (let ((values (sort (mapcar (lambda (value)
+ (car (jabber-xml-node-children value)))
+ (jabber-xml-get-children field 'value))
+ #'string<)))
+ ;; For each <value/> element, append the XML character
+ ;; data, followed by the '<' character.
+ (dolist (value values)
+ (insert value "<"))))))))
+
+ ;; 8. Ensure that S is encoded according to the UTF-8 encoding
+ ;; (RFC 3269 [18]).
+ (let ((s (encode-coding-string (buffer-string) 'utf-8 t))
+ (algorithm (cdr (assoc hash jabber-caps-hash-names))))
+ ;; 9. Compute the verification string by hashing S using the
+ ;; algorithm specified in the 'hash' attribute (e.g., SHA-1 as
+ ;; defined in RFC 3174 [19]). The hashed data MUST be generated
+ ;; with binary output and encoded using Base64 as specified in
+ ;; Section 4 of RFC 4648 [20] (note: the Base64 output MUST NOT
+ ;; include whitespace and MUST set padding bits to zero). [21]
+ (base64-encode-string (secure-hash algorithm s nil nil t) t))))
+
+(defun jabber-caps-identity-< (a b)
+ (let ((a-category (jabber-xml-get-attribute a 'category))
+ (b-category (jabber-xml-get-attribute b 'category)))
+ (or (string< a-category b-category)
+ (and (string= a-category b-category)
+ (let ((a-type (jabber-xml-get-attribute a 'type))
+ (b-type (jabber-xml-get-attribute b 'type)))
+ (or (string< a-type b-type)
+ (and (string= a-type b-type)
+ (let ((a-xml:lang (jabber-xml-get-attribute a 'xml:lang))
+ (b-xml:lang (jabber-xml-get-attribute b 'xml:lang)))
+ (string< a-xml:lang b-xml:lang)))))))))
+
+
(provide 'jabber-disco)
;;; arch-tag: 71f5c76f-2956-4ed2-b871-9f5fe198092d
diff --git a/jabber-muc.el b/jabber-muc.el
index 45a7bd8..ceb8bc4 100644
--- a/jabber-muc.el
+++ b/jabber-muc.el
@@ -22,7 +22,7 @@
(require 'jabber-chat)
(require 'jabber-widget)
-(require 'jabber-newdisco)
+(require 'jabber-disco)
(require 'jabber-muc-nick-coloring)
(require 'cl)
diff --git a/jabber-newdisco.el b/jabber-newdisco.el
deleted file mode 100644
index 7d3d286..0000000
--- a/jabber-newdisco.el
+++ /dev/null
@@ -1,399 +0,0 @@
-;;; jabber-newdisco.el --- caching disco API
-
-;; Copyright (C) 2005, 2008 Magnus Henoch
-
-;; Author: Magnus Henoch <ma...@fr...>
-
-;; This file 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, or (at your option)
-;; any later version.
-
-;; This file 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(require 'jabber-xml)
-
-;;---
-;; Keys are ("jid" . "node"), where "node" is nil if appropriate.
-;; Values are (identities features), where each identity is ["name"
-;; "category" "type"], and each feature is a string.
-(defvar jabber-disco-info-cache (make-hash-table :test 'equal))
-
-;; Keys are ("jid" . "node"). Values are (items), where each
-;; item is ["name" "jid" "node"] (some values may be nil).
-(defvar jabber-disco-items-cache (make-hash-table :test 'equal))
-
-;;; Info
-
-(defun jabber-disco-get-info (jc jid node callback closure-data &optional force)
- "Get disco info for JID and NODE, using connection JC.
-Call CALLBACK with JC and CLOSURE-DATA as first and second
-arguments and result as third argument when result is available.
-On success, result is (IDENTITIES FEATURES), where each identity is [\"name\"
-\"category\" \"type\"], and each feature is a string.
-On error, result is the error node, recognizable by (eq (car result) 'error).
-
-If CALLBACK is nil, just fetch data. If FORCE is non-nil,
-invalidate cache and get fresh data."
- (when force
- (remhash (cons jid node) jabber-disco-info-cache))
- (let ((result (unless force (jabber-disco-get-info-immediately jid node))))
- (if result
- (and callback (run-with-timer 0 nil callback jc closure-data result))
- (jabber-send-iq jc jid
- "get"
- `(query ((xmlns . "http://jabber.org/protocol/disco#info")
- ,@(when node `((node . ,node)))))
- #'jabber-disco-got-info (cons callback closure-data)
- (lambda (jc xml-data callback-data)
- (when (car callback-data)
- (funcall (car callback-data) jc (cdr callback-data) (jabber-iq-error xml-data))))
- (cons callback closure-data)))))
-
-(defun jabber-disco-got-info (jc xml-data callback-data)
- (let ((jid (jabber-xml-get-attribute xml-data 'from))
- (node (jabber-xml-get-attribute (jabber-iq-query xml-data)
- 'node))
- (result (jabber-disco-parse-info xml-data)))
- (puthash (cons jid node) result jabber-disco-info-cache)
- (when (car callback-data)
- (funcall (car callback-data) jc (cdr callback-data) result))))
-
-(defun jabber-disco-parse-info (xml-data)
- "Extract data from an <iq/> stanza containing a disco#info result.
-See `jabber-disco-get-info' for a description of the return value."
- (list
- (mapcar
- #'(lambda (id)
- (vector (jabber-xml-get-attribute id 'name)
- (jabber-xml-get-attribute id 'category)
- (jabber-xml-get-attribute id 'type)))
- (jabber-xml-get-children (jabber-iq-query xml-data) 'identity))
- (mapcar
- #'(lambda (feature)
- (jabber-xml-get-attribute feature 'var))
- (jabber-xml-get-children (jabber-iq-query xml-data) 'feature))))
-
-(defun jabber-disco-get-info-immediately (jid node)
- "Get cached disco info for JID and NODE.
-Return nil if no info available.
-
-Fill the cache with `jabber-disco-get-info'."
- (or
- ;; Check "normal" cache...
- (gethash (cons jid node) jabber-disco-info-cache)
- ;; And then check Entity Capabilities.
- (and (null node) (jabber-caps-get-cached jid))))
-
-;;; Items
-
-(defun jabber-disco-get-items (jc jid node callback closure-data &optional force)
- "Get disco items for JID and NODE, using connection JC.
-Call CALLBACK with JC and CLOSURE-DATA as first and second
-arguments and items result as third argument when result is
-available.
-On success, result is a list of items, where each
-item is [\"name\" \"jid\" \"node\"] (some values may be nil).
-On error, result is the error node, recognizable by (eq (car result) 'error).
-
-If CALLBACK is nil, just fetch data. If FORCE is non-nil,
-invalidate cache and get fresh data."
- (when force
- (remhash (cons jid node) jabber-disco-items-cache))
- (let ((result (gethash (cons jid node) jabber-disco-items-cache)))
- (if result
- (and callback (run-with-timer 0 nil callback jc closure-data result))
- (jabber-send-iq jc jid
- "get"
- `(query ((xmlns . "http://jabber.org/protocol/disco#items")
- ,@(when node `((node . ,node)))))
- #'jabber-disco-got-items (cons callback closure-data)
- (lambda (jc xml-data callback-data)
- (when (car callback-data)
- (funcall (car callback-data) jc (cdr callback-data) (jabber-iq-error xml-data))))
- (cons callback closure-data)))))
-
-(defun jabber-disco-got-items (jc xml-data callback-data)
- (let ((jid (jabber-xml-get-attribute xml-data 'from))
- (node (jabber-xml-get-attribute (jabber-iq-query xml-data)
- 'node))
- (result
- (mapcar
- #'(lambda (item)
- (vector
- (jabber-xml-get-attribute item 'name)
- (jabber-xml-get-attribute item 'jid)
- (jabber-xml-get-attribute item 'node)))
- (jabber-xml-get-children (jabber-iq-query xml-data) 'item))))
- (puthash (cons jid node) result jabber-disco-items-cache)
- (when (car callback-data)
- (funcall (car callback-data) jc (cdr callback-data) result))))
-
-(defun jabber-disco-get-items-immediately (jid node)
- (gethash (cons jid node) jabber-disco-items-cache))
-
-;;; Publish
-
-(defun jabber-disco-publish (jc node item-name item-jid item-node)
- "Publish the given item under disco node NODE."
- (jabber-send-iq jc nil
- "set"
- `(query ((xmlns . "http://jabber.org/protocol/disco#items")
- ,@(when node `((node . ,node))))
- (item ((action . "update")
- (jid . ,item-jid)
- ,@(when item-name
- `((name . ,item-name)))
- ,@(when item-node
- `((node . ,item-node))))))
- 'jabber-report-success "Disco publish"
- 'jabber-report-success "Disco publish"))
-
-(defun jabber-disco-publish-remove (jc node item-jid item-node)
- "Remove the given item from published disco items."
- (jabber-send-iq jc nil
- "set"
- `(query ((xmlns . "http://jabber.org/protocol/disco#items")
- ,@(when node `((node . ,node))))
- (item ((action . "remove")
- (jid . ,item-jid)
- ,@(when item-node
- `((node . ,item-node))))))
- 'jabber-report-success "Disco removal"
- 'jabber-report-success "Disco removal"))
-
-;;; Entity Capabilities (XEP-0115)
-
-;;;###autoload
-(eval-after-load "jabber-core"
- '(add-to-list 'jabber-presence-chain #'jabber-process-caps))
-
-(defvar jabber-caps-cache (make-hash-table :test 'equal))
-
-(defconst jabber-caps-hash-names
- '(("sha-1" . sha1)
- ("sha-224" . sha224)
- ("sha-256" . sha256)
- ("sha-384" . sha384)
- ("sha-512" . sha512))
- "Hash function name map.
-Maps names defined in http://www.iana.org/assignments/hash-function-text-names
-to symbols accepted by `secure-hash'.
-
-XEP-0115 currently recommends SHA-1, but let's be future-proof.")
-
-(defun jabber-caps-get-cached (jid)
- "Get disco info from Entity Capabilities cache.
-JID should be a string containing a full JID.
-Return (IDENTITIES FEATURES), or nil if not in cache."
- (let* ((symbol (jabber-jid-symbol jid))
- (resource (or (jabber-jid-resource jid) ""))
- (resource-plist (cdr (assoc resource (get symbol 'resources))))
- (key (plist-get resource-plist 'caps)))
- (when key
- (let ((cache-entry (gethash key jabber-caps-cache)))
- (when (and (consp cache-entry) (not (floatp (car cache-entry))))
- cache-entry)))))
-
-;;;###autoload
-(defun jabber-process-caps (jc xml-data)
- "Look for entity capabilities in presence stanzas."
- (let* ((from (jabber-xml-get-attribute xml-data 'from))
- (c (jabber-xml-path xml-data '(("http://jabber.org/protocol/caps" . "c")))))
- (when c
- (jabber-xml-let-attributes
- (ext hash node ver) c
- (cond
- (hash
- ;; If the <c/> element has a hash attribute, it follows the
- ;; "modern" version of XEP-0115.
- (jabber-process-caps-modern jc from hash node ver))
- (t
- ;; No hash attribute. Use legacy version of XEP-0115.
- ;; TODO: do something clever here.
- ))))))
-
-(defun jabber-process-caps-modern (jc jid hash node ver)
- (when (assoc hash jabber-caps-hash-names)
- ;; We support the hash function used.
- (let* ((key (cons hash ver))
- (cache-entry (gethash key jabber-caps-cache)))
- ;; Remember the hash in the JID symbol.
- (let* ((symbol (jabber-jid-symbol jid))
- (resource (or (jabber-jid-resource jid) ""))
- (resource-entry (assoc resource (get symbol 'resources)))
- (new-resource-plist (plist-put (cdr resource-entry) 'caps key)))
- (if resource-entry
- (setf (cdr resource-entry) new-resource-plist)
- (push (cons resource new-resource-plist) (get symbol 'resources))))
-
- (flet ((request-disco-info
- ()
- (jabber-send-iq
- jc jid
- "get"
- `(query ((xmlns . "http://jabber.org/protocol/disco#info")
- (node . ,(concat node "#" ver))))
- #'jabber-process-caps-info-result (list hash node ver)
- #'jabber-process-caps-info-error (list hash node ver))))
- (cond
- ((and (consp cache-entry)
- (floatp (car cache-entry)))
- ;; We have a record of asking someone about this hash.
- (if (< (- (float-time) (car cache-entry)) 10.0)
- ;; We asked someone about this hash less than 10 seconds ago.
- ;; Let's add the new JID to the entry, just in case that
- ;; doesn't work out.
- (pushnew jid (cdr cache-entry) :test #'string=)
- ;; We asked someone about it more than 10 seconds ago.
- ;; They're probably not going to answer. Let's ask
- ;; this contact about it instead.
- (setf (car cache-entry) (float-time))
- (request-disco-info)))
- ((null cache-entry)
- ;; We know nothing about this hash. Let's note the
- ;; fact that we tried to get information about it.
- (puthash key (list (float-time)) jabber-caps-cache)
- (request-disco-info))
- (t
- ;; We already know what this hash represents, so we
- ;; can cache info for this contact.
- (puthash (cons jid nil) cache-entry jabber-disco-info-cache)))))))
-
-(defun jabber-process-caps-info-result (jc xml-data closure-data)
- (destructuring-bind (hash node ver) closure-data
- (let* ((key (cons hash ver))
- (query (jabber-iq-query xml-data))
- (verification-string (jabber-caps-ver-string query hash)))
- (if (string= ver verification-string)
- ;; The hash is correct; save info.
- (puthash key (jabber-disco-parse-info xml-data) jabber-caps-cache)
- ;; The hash is incorrect.
- (jabber-caps-try-next jc hash node ver)))))
-
-(defun jabber-process-caps-info-error (jc xml-data closure-data)
- (destructuring-bind (hash node ver) closure-data
- (jabber-caps-try-next jc hash node ver)))
-
-(defun jabber-caps-try-next (jc hash node ver)
- (let* ((key (cons hash ver))
- (cache-entry (gethash key jabber-caps-cache)))
- (when (floatp (car-safe cache-entry))
- (let ((next-jid (pop (cdr cache-entry))))
- ;; Do we know someone else we could ask about this hash?
- (if next-jid
- (progn
- (setf (car cache-entry) (float-time))
- (jabber-send-iq
- jc next-jid
- "get"
- `(query ((xmlns . "http://jabber.org/protocol/disco#info")
- (node . ,(concat node "#" ver))))
- #'jabber-process-caps-info-result key
- #'jabber-process-caps-info-error key))
- ;; No, forget about it for now.
- (remhash key jabber-caps-cache))))))
-
-(defun jabber-caps-ver-string (query hash)
- ;; XEP-0115, section 5.1
- ;; 1. Initialize an empty string S.
- (with-temp-buffer
- (let* ((identities (jabber-xml-get-children query 'identity))
- (features (mapcar (lambda (feature) (jabber-xml-get-attribute feature 'var))
- (jabber-xml-get-children query 'feature)))
- (maybe-forms (jabber-xml-get-children query 'x))
- (forms (remove-if-not
- (lambda (x)
- ;; Keep elements that are forms and have a FORM_TYPE,
- ;; according to XEP-0128.
- (and (string= (jabber-xml-get-xmlns x) "jabber:x:data")
- (jabber-xdata-formtype x)))
- maybe-forms)))
- ;; 2. Sort the service discovery identities [15] by category
- ;; and then by type and then by xml:lang (if it exists),
- ;; formatted as CATEGORY '/' [TYPE] '/' [LANG] '/'
- ;; [NAME]. [16] Note that each slash is included even if the
- ;; LANG or NAME is not included (in accordance with XEP-0030,
- ;; the category and type MUST be included.
- (setq identities (sort identities #'jabber-caps-identity-<))
- ;; 3. For each identity, append the 'category/type/lang/name' to
- ;; S, followed by the '<' character.
- (dolist (identity identities)
- (jabber-xml-let-attributes (category type xml:lang name) identity
- ;; Use `concat' here instead of passing everything to
- ;; `insert', since `concat' tolerates nil values.
- (insert (concat category "/" type "/" xml:lang "/" name "<"))))
- ;; 4. Sort the supported service discovery features. [17]
- (setq features (sort features #'string<))
- ;; 5. For each feature, append the feature to S, followed by the
- ;; '<' character.
- (dolist (feature features)
- (insert feature "<"))
- ;; 6. If the service discovery information response includes
- ;; XEP-0128 data forms, sort the forms by the FORM_TYPE (i.e.,
- ;; by the XML character data of the <value/> element).
- (setq forms (sort forms (lambda (a b)
- (string< (jabber-xdata-formtype a)
- (jabber-xdata-formtype b)))))
- ;; 7. For each extended service discovery information form:
- (dolist (form forms)
- ;; Append the XML character data of the FORM_TYPE field's
- ;; <value/> element, followed by the '<' character.
- (insert (jabber-xdata-formtype form) "<")
- ;; Sort the fields by the value of the "var" attribute.
- (let ((fields (sort (jabber-xml-get-children form 'field)
- (lambda (a b)
- (string< (jabber-xml-get-attribute a 'var)
- (jabber-xml-get-attribute b 'var))))))
- (dolist (field fields)
- ;; For each field other than FORM_TYPE:
- (unless (string= (jabber-xml-get-attribute field 'var) "FORM_TYPE")
- ;; Append the value of the "var" attribute, followed by the '<' character.
- (insert (jabber-xml-get-attribute field 'var) "<")
- ;; Sort values by the XML character data of the <value/> element.
- (let ((values (sort (mapcar (lambda (value)
- (car (jabber-xml-node-children value)))
- (jabber-xml-get-children field 'value))
- #'string<)))
- ;; For each <value/> element, append the XML character
- ;; data, followed by the '<' character.
- (dolist (value values)
- (insert value "<"))))))))
-
- ;; 8. Ensure that S is encoded according to the UTF-8 encoding
- ;; (RFC 3269 [18]).
- (let ((s (encode-coding-string (buffer-string) 'utf-8 t))
- (algorithm (cdr (assoc hash jabber-caps-hash-names))))
- ;; 9. Compute the verification string by hashing S using the
- ;; algorithm specified in the 'hash' attribute (e.g., SHA-1 as
- ;; defined in RFC 3174 [19]). The hashed data MUST be generated
- ;; with binary output and encoded using Base64 as specified in
- ;; Section 4 of RFC 4648 [20] (note: the Base64 output MUST NOT
- ;; include whitespace and MUST set padding bits to zero). [21]
- (base64-encode-string (secure-hash algorithm s nil nil t) t))))
-
-(defun jabber-caps-identity-< (a b)
- (let ((a-category (jabber-xml-get-attribute a 'category))
- (b-category (jabber-xml-get-attribute b 'category)))
- (or (string< a-category b-category)
- (and (string= a-category b-category)
- (let ((a-type (jabber-xml-get-attribute a 'type))
- (b-type (jabber-xml-get-attribute b 'type)))
- (or (string< a-type b-type)
- (and (string= a-type b-type)
- (let ((a-xml:lang (jabber-xml-get-attribute a 'xml:lang))
- (b-xml:lang (jabber-xml-get-attribute b 'xml:lang)))
- (string< a-xml:lang b-xml:lang)))))))))
-
-
-(provide 'jabber-newdisco)
-
-;; arch-tag: b47c06aa-cae6-11d9-b1c0-000a95c2fcd0
diff --git a/jabber-socks5.el b/jabber-socks5.el
index ee64033..54e6a90 100644
--- a/jabber-socks5.el
+++ b/jabber-socks5.el
@@ -23,7 +23,6 @@
(require 'jabber-disco)
(require 'jabber-si-server)
(require 'jabber-si-client)
-(require 'jabber-newdisco)
(require 'fsm)
(eval-when-compile (require 'cl))
-----------------------------------------------------------------------
Summary of changes:
Makefile.am | 2 +-
jabber-ahc.el | 2 +-
jabber-chatstates.el | 2 +-
jabber-disco.el | 537 +++++++++++++++++++++++++++++++++++++++++++-----
jabber-feature-neg.el | 2 +-
jabber-ft-server.el | 2 +-
jabber-muc.el | 2 +-
jabber-newdisco.el | 399 ------------------------------------
jabber-ping.el | 2 +-
jabber-rtt.el | 4 +
jabber-si-server.el | 2 +-
jabber-socks5.el | 3 +-
jabber-time.el | 6 +-
jabber-version.el | 2 +-
jabber-widget.el | 2 +-
15 files changed, 499 insertions(+), 470 deletions(-)
delete mode 100644 jabber-newdisco.el
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-24 23:34:22
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via d11bda5e659ceb4d17b33ac0df78dfb6a6f27625 (commit)
from b5cb0d640e7771908d4e772625c79c65c756059e (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit d11bda5e659ceb4d17b33ac0df78dfb6a6f27625
Author: Magnus Henoch <leg...@us...>
Date: Sun Nov 24 23:33:03 2013 +0000
srv.el: call nslookup if UDP sockets not supported
dns.el requires support for UDP sockets, which is not present on
Windows. Check whether UDP sockets are supported, and if not, parse
the output of nslookup.
diff --git a/srv.el b/srv.el
index e8a3a63..6ead479 100644
--- a/srv.el
+++ b/srv.el
@@ -47,9 +47,7 @@ of the list. The list is empty if no SRV records were found."
(unless (assq 'SRV dns-query-types)
(error "dns.el doesn't support SRV lookups"))
;; `dns-query' used to be `query-dns'. Try both names for now.
- (let* ((result (if (fboundp 'query-dns)
- (query-dns target 'SRV t)
- (dns-query target 'SRV t)))
+ (let* ((result (srv--dns-query target))
(answers (mapcar #'(lambda (a)
(cadr (assq 'data a)))
(cadr (assq 'answers result))))
@@ -97,6 +95,37 @@ of the list. The list is empty if no SRV records were found."
(cadr (assq 'port a))))
(nreverse weighted-result)))))
+(defun srv--dns-query (target)
+ ;; dns-query uses UDP, but that is not supported on Windows...
+ (if (featurep 'make-network-process '(:type datagram))
+ (if (fboundp 'query-dns)
+ (query-dns target 'SRV t)
+ (dns-query target 'SRV t))
+ ;; ...so let's call nslookup instead.
+ (srv--nslookup target)))
+
+(defun srv--nslookup (target)
+ (with-temp-buffer
+ (call-process "nslookup" nil t nil "-type=srv" target)
+ (goto-char (point-min))
+ (let (results)
+ (while (search-forward-regexp
+ (concat "[\s\t]*priority += \\(.*\\)\r?\n"
+ "[\s\t]*weight += \\(.*\\)\r?\n"
+ "[\s\t]*port += \\(.*\\)\r?\n"
+ "[\s\t]*svr hostname += \\(.*\\)\r?\n")
+ nil t)
+ (push
+ (list
+ (list 'data
+ (list
+ (list 'priority (string-to-number (match-string 1)))
+ (list 'weight (string-to-number (match-string 2)))
+ (list 'port (string-to-number (match-string 3)))
+ (list 'target (match-string 4)))))
+ results))
+ (list (list 'answers results)))))
+
(provide 'srv)
;; arch-tag: b43358f2-d241-11da-836e-000a95c2fcd0
;;; srv.el ends here
-----------------------------------------------------------------------
Summary of changes:
srv.el | 35 ++++++++++++++++++++++++++++++++---
1 files changed, 32 insertions(+), 3 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-23 23:34:36
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, rtt has been updated
via 0b40a35043e7f6fb256411c2b9287b820c6d7ec1 (commit)
from 74a98f3da67f3f438889eb801ea49237a9ea1003 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 0b40a35043e7f6fb256411c2b9287b820c6d7ec1
Author: Magnus Henoch <mag...@gm...>
Date: Sat Nov 23 23:31:10 2013 +0000
Interpret incoming Entity Capabilities information (XEP-0115)
Look for capabilities information in incoming presence stanzas, retrieve
and verify disco info as needed, and plug into "normal" disco info
cache.
diff --git a/jabber-newdisco.el b/jabber-newdisco.el
index aefa910..7d3d286 100644
--- a/jabber-newdisco.el
+++ b/jabber-newdisco.el
@@ -19,6 +19,8 @@
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+(require 'jabber-xml)
+
;;---
;; Keys are ("jid" . "node"), where "node" is nil if appropriate.
;; Values are (identities features), where each identity is ["name"
@@ -43,7 +45,7 @@ If CALLBACK is nil, just fetch data. If FORCE is non-nil,
invalidate cache and get fresh data."
(when force
(remhash (cons jid node) jabber-disco-info-cache))
- (let ((result (gethash (cons jid node) jabber-disco-info-cache)))
+ (let ((result (unless force (jabber-disco-get-info-immediately jid node))))
(if result
(and callback (run-with-timer 0 nil callback jc closure-data result))
(jabber-send-iq jc jid
@@ -60,28 +62,36 @@ invalidate cache and get fresh data."
(let ((jid (jabber-xml-get-attribute xml-data 'from))
(node (jabber-xml-get-attribute (jabber-iq-query xml-data)
'node))
- (result
- (list
- (mapcar
- #'(lambda (id)
- (vector (jabber-xml-get-attribute id 'name)
- (jabber-xml-get-attribute id 'category)
- (jabber-xml-get-attribute id 'type)))
- (jabber-xml-get-children (jabber-iq-query xml-data) 'identity))
- (mapcar
- #'(lambda (feature)
- (jabber-xml-get-attribute feature 'var))
- (jabber-xml-get-children (jabber-iq-query xml-data) 'feature)))))
+ (result (jabber-disco-parse-info xml-data)))
(puthash (cons jid node) result jabber-disco-info-cache)
(when (car callback-data)
(funcall (car callback-data) jc (cdr callback-data) result))))
+(defun jabber-disco-parse-info (xml-data)
+ "Extract data from an <iq/> stanza containing a disco#info result.
+See `jabber-disco-get-info' for a description of the return value."
+ (list
+ (mapcar
+ #'(lambda (id)
+ (vector (jabber-xml-get-attribute id 'name)
+ (jabber-xml-get-attribute id 'category)
+ (jabber-xml-get-attribute id 'type)))
+ (jabber-xml-get-children (jabber-iq-query xml-data) 'identity))
+ (mapcar
+ #'(lambda (feature)
+ (jabber-xml-get-attribute feature 'var))
+ (jabber-xml-get-children (jabber-iq-query xml-data) 'feature))))
+
(defun jabber-disco-get-info-immediately (jid node)
"Get cached disco info for JID and NODE.
Return nil if no info available.
Fill the cache with `jabber-disco-get-info'."
- (gethash (cons jid node) jabber-disco-info-cache))
+ (or
+ ;; Check "normal" cache...
+ (gethash (cons jid node) jabber-disco-info-cache)
+ ;; And then check Entity Capabilities.
+ (and (null node) (jabber-caps-get-cached jid))))
;;; Items
@@ -160,6 +170,230 @@ invalidate cache and get fresh data."
'jabber-report-success "Disco removal"
'jabber-report-success "Disco removal"))
+;;; Entity Capabilities (XEP-0115)
+
+;;;###autoload
+(eval-after-load "jabber-core"
+ '(add-to-list 'jabber-presence-chain #'jabber-process-caps))
+
+(defvar jabber-caps-cache (make-hash-table :test 'equal))
+
+(defconst jabber-caps-hash-names
+ '(("sha-1" . sha1)
+ ("sha-224" . sha224)
+ ("sha-256" . sha256)
+ ("sha-384" . sha384)
+ ("sha-512" . sha512))
+ "Hash function name map.
+Maps names defined in http://www.iana.org/assignments/hash-function-text-names
+to symbols accepted by `secure-hash'.
+
+XEP-0115 currently recommends SHA-1, but let's be future-proof.")
+
+(defun jabber-caps-get-cached (jid)
+ "Get disco info from Entity Capabilities cache.
+JID should be a string containing a full JID.
+Return (IDENTITIES FEATURES), or nil if not in cache."
+ (let* ((symbol (jabber-jid-symbol jid))
+ (resource (or (jabber-jid-resource jid) ""))
+ (resource-plist (cdr (assoc resource (get symbol 'resources))))
+ (key (plist-get resource-plist 'caps)))
+ (when key
+ (let ((cache-entry (gethash key jabber-caps-cache)))
+ (when (and (consp cache-entry) (not (floatp (car cache-entry))))
+ cache-entry)))))
+
+;;;###autoload
+(defun jabber-process-caps (jc xml-data)
+ "Look for entity capabilities in presence stanzas."
+ (let* ((from (jabber-xml-get-attribute xml-data 'from))
+ (c (jabber-xml-path xml-data '(("http://jabber.org/protocol/caps" . "c")))))
+ (when c
+ (jabber-xml-let-attributes
+ (ext hash node ver) c
+ (cond
+ (hash
+ ;; If the <c/> element has a hash attribute, it follows the
+ ;; "modern" version of XEP-0115.
+ (jabber-process-caps-modern jc from hash node ver))
+ (t
+ ;; No hash attribute. Use legacy version of XEP-0115.
+ ;; TODO: do something clever here.
+ ))))))
+
+(defun jabber-process-caps-modern (jc jid hash node ver)
+ (when (assoc hash jabber-caps-hash-names)
+ ;; We support the hash function used.
+ (let* ((key (cons hash ver))
+ (cache-entry (gethash key jabber-caps-cache)))
+ ;; Remember the hash in the JID symbol.
+ (let* ((symbol (jabber-jid-symbol jid))
+ (resource (or (jabber-jid-resource jid) ""))
+ (resource-entry (assoc resource (get symbol 'resources)))
+ (new-resource-plist (plist-put (cdr resource-entry) 'caps key)))
+ (if resource-entry
+ (setf (cdr resource-entry) new-resource-plist)
+ (push (cons resource new-resource-plist) (get symbol 'resources))))
+
+ (flet ((request-disco-info
+ ()
+ (jabber-send-iq
+ jc jid
+ "get"
+ `(query ((xmlns . "http://jabber.org/protocol/disco#info")
+ (node . ,(concat node "#" ver))))
+ #'jabber-process-caps-info-result (list hash node ver)
+ #'jabber-process-caps-info-error (list hash node ver))))
+ (cond
+ ((and (consp cache-entry)
+ (floatp (car cache-entry)))
+ ;; We have a record of asking someone about this hash.
+ (if (< (- (float-time) (car cache-entry)) 10.0)
+ ;; We asked someone about this hash less than 10 seconds ago.
+ ;; Let's add the new JID to the entry, just in case that
+ ;; doesn't work out.
+ (pushnew jid (cdr cache-entry) :test #'string=)
+ ;; We asked someone about it more than 10 seconds ago.
+ ;; They're probably not going to answer. Let's ask
+ ;; this contact about it instead.
+ (setf (car cache-entry) (float-time))
+ (request-disco-info)))
+ ((null cache-entry)
+ ;; We know nothing about this hash. Let's note the
+ ;; fact that we tried to get information about it.
+ (puthash key (list (float-time)) jabber-caps-cache)
+ (request-disco-info))
+ (t
+ ;; We already know what this hash represents, so we
+ ;; can cache info for this contact.
+ (puthash (cons jid nil) cache-entry jabber-disco-info-cache)))))))
+
+(defun jabber-process-caps-info-result (jc xml-data closure-data)
+ (destructuring-bind (hash node ver) closure-data
+ (let* ((key (cons hash ver))
+ (query (jabber-iq-query xml-data))
+ (verification-string (jabber-caps-ver-string query hash)))
+ (if (string= ver verification-string)
+ ;; The hash is correct; save info.
+ (puthash key (jabber-disco-parse-info xml-data) jabber-caps-cache)
+ ;; The hash is incorrect.
+ (jabber-caps-try-next jc hash node ver)))))
+
+(defun jabber-process-caps-info-error (jc xml-data closure-data)
+ (destructuring-bind (hash node ver) closure-data
+ (jabber-caps-try-next jc hash node ver)))
+
+(defun jabber-caps-try-next (jc hash node ver)
+ (let* ((key (cons hash ver))
+ (cache-entry (gethash key jabber-caps-cache)))
+ (when (floatp (car-safe cache-entry))
+ (let ((next-jid (pop (cdr cache-entry))))
+ ;; Do we know someone else we could ask about this hash?
+ (if next-jid
+ (progn
+ (setf (car cache-entry) (float-time))
+ (jabber-send-iq
+ jc next-jid
+ "get"
+ `(query ((xmlns . "http://jabber.org/protocol/disco#info")
+ (node . ,(concat node "#" ver))))
+ #'jabber-process-caps-info-result key
+ #'jabber-process-caps-info-error key))
+ ;; No, forget about it for now.
+ (remhash key jabber-caps-cache))))))
+
+(defun jabber-caps-ver-string (query hash)
+ ;; XEP-0115, section 5.1
+ ;; 1. Initialize an empty string S.
+ (with-temp-buffer
+ (let* ((identities (jabber-xml-get-children query 'identity))
+ (features (mapcar (lambda (feature) (jabber-xml-get-attribute feature 'var))
+ (jabber-xml-get-children query 'feature)))
+ (maybe-forms (jabber-xml-get-children query 'x))
+ (forms (remove-if-not
+ (lambda (x)
+ ;; Keep elements that are forms and have a FORM_TYPE,
+ ;; according to XEP-0128.
+ (and (string= (jabber-xml-get-xmlns x) "jabber:x:data")
+ (jabber-xdata-formtype x)))
+ maybe-forms)))
+ ;; 2. Sort the service discovery identities [15] by category
+ ;; and then by type and then by xml:lang (if it exists),
+ ;; formatted as CATEGORY '/' [TYPE] '/' [LANG] '/'
+ ;; [NAME]. [16] Note that each slash is included even if the
+ ;; LANG or NAME is not included (in accordance with XEP-0030,
+ ;; the category and type MUST be included.
+ (setq identities (sort identities #'jabber-caps-identity-<))
+ ;; 3. For each identity, append the 'category/type/lang/name' to
+ ;; S, followed by the '<' character.
+ (dolist (identity identities)
+ (jabber-xml-let-attributes (category type xml:lang name) identity
+ ;; Use `concat' here instead of passing everything to
+ ;; `insert', since `concat' tolerates nil values.
+ (insert (concat category "/" type "/" xml:lang "/" name "<"))))
+ ;; 4. Sort the supported service discovery features. [17]
+ (setq features (sort features #'string<))
+ ;; 5. For each feature, append the feature to S, followed by the
+ ;; '<' character.
+ (dolist (feature features)
+ (insert feature "<"))
+ ;; 6. If the service discovery information response includes
+ ;; XEP-0128 data forms, sort the forms by the FORM_TYPE (i.e.,
+ ;; by the XML character data of the <value/> element).
+ (setq forms (sort forms (lambda (a b)
+ (string< (jabber-xdata-formtype a)
+ (jabber-xdata-formtype b)))))
+ ;; 7. For each extended service discovery information form:
+ (dolist (form forms)
+ ;; Append the XML character data of the FORM_TYPE field's
+ ;; <value/> element, followed by the '<' character.
+ (insert (jabber-xdata-formtype form) "<")
+ ;; Sort the fields by the value of the "var" attribute.
+ (let ((fields (sort (jabber-xml-get-children form 'field)
+ (lambda (a b)
+ (string< (jabber-xml-get-attribute a 'var)
+ (jabber-xml-get-attribute b 'var))))))
+ (dolist (field fields)
+ ;; For each field other than FORM_TYPE:
+ (unless (string= (jabber-xml-get-attribute field 'var) "FORM_TYPE")
+ ;; Append the value of the "var" attribute, followed by the '<' character.
+ (insert (jabber-xml-get-attribute field 'var) "<")
+ ;; Sort values by the XML character data of the <value/> element.
+ (let ((values (sort (mapcar (lambda (value)
+ (car (jabber-xml-node-children value)))
+ (jabber-xml-get-children field 'value))
+ #'string<)))
+ ;; For each <value/> element, append the XML character
+ ;; data, followed by the '<' character.
+ (dolist (value values)
+ (insert value "<"))))))))
+
+ ;; 8. Ensure that S is encoded according to the UTF-8 encoding
+ ;; (RFC 3269 [18]).
+ (let ((s (encode-coding-string (buffer-string) 'utf-8 t))
+ (algorithm (cdr (assoc hash jabber-caps-hash-names))))
+ ;; 9. Compute the verification string by hashing S using the
+ ;; algorithm specified in the 'hash' attribute (e.g., SHA-1 as
+ ;; defined in RFC 3174 [19]). The hashed data MUST be generated
+ ;; with binary output and encoded using Base64 as specified in
+ ;; Section 4 of RFC 4648 [20] (note: the Base64 output MUST NOT
+ ;; include whitespace and MUST set padding bits to zero). [21]
+ (base64-encode-string (secure-hash algorithm s nil nil t) t))))
+
+(defun jabber-caps-identity-< (a b)
+ (let ((a-category (jabber-xml-get-attribute a 'category))
+ (b-category (jabber-xml-get-attribute b 'category)))
+ (or (string< a-category b-category)
+ (and (string= a-category b-category)
+ (let ((a-type (jabber-xml-get-attribute a 'type))
+ (b-type (jabber-xml-get-attribute b 'type)))
+ (or (string< a-type b-type)
+ (and (string= a-type b-type)
+ (let ((a-xml:lang (jabber-xml-get-attribute a 'xml:lang))
+ (b-xml:lang (jabber-xml-get-attribute b 'xml:lang)))
+ (string< a-xml:lang b-xml:lang)))))))))
+
+
(provide 'jabber-newdisco)
;; arch-tag: b47c06aa-cae6-11d9-b1c0-000a95c2fcd0
-----------------------------------------------------------------------
Summary of changes:
jabber-newdisco.el | 262 +++++++++++++++++++++++++++++++++++++++++++++++++---
1 files changed, 248 insertions(+), 14 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-14 10:29:44
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, rtt has been updated
via 74a98f3da67f3f438889eb801ea49237a9ea1003 (commit)
via d1732df73a4c192761ba137a3a6dca1cc8128b9e (commit)
from ccd6e4a596aba77bf7ba2759068e937c01453d42 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 74a98f3da67f3f438889eb801ea49237a9ea1003
Author: Magnus Henoch <mag...@gm...>
Date: Thu Nov 14 10:22:26 2013 +0000
Add jabber-rtt-send-mode, for sending Real Time Text events
diff --git a/jabber-rtt.el b/jabber-rtt.el
index 44e98bb..65d5272 100644
--- a/jabber-rtt.el
+++ b/jabber-rtt.el
@@ -23,6 +23,8 @@
;;; Code:
+;;;; Handling incoming events
+
(defvar jabber-rtt-ewoc-node nil)
(make-variable-buffer-local 'jabber-rtt-ewoc-node)
@@ -170,5 +172,142 @@
action))
actions)))))
+;;;; Sending events
+
+(defvar jabber-rtt-send-timer nil)
+(make-variable-buffer-local 'jabber-rtt-send-timer)
+
+(defvar jabber-rtt-send-seq nil)
+(make-variable-buffer-local 'jabber-rtt-send-seq)
+
+(defvar jabber-rtt-outgoing-events nil)
+(make-variable-buffer-local 'jabber-rtt-outgoing-events)
+
+(defvar jabber-rtt-send-last-timestamp nil)
+(make-variable-buffer-local 'jabber-rtt-send-last-timestamp)
+
+(define-minor-mode jabber-rtt-send-mode
+ "Show text to recipient as it is being typed.
+This lets the recipient see every change made to the message up
+until it's sent. The recipient's client needs to implement
+XEP-0301, In-Band Real Time Text."
+ nil " Real-Time" nil
+ (if (null jabber-rtt-send-mode)
+ (progn
+ (remove-hook 'after-change-functions #'jabber-rtt--queue-update t)
+ (remove-hook 'jabber-chat-send-hooks #'jabber-rtt--message-sent t)
+ (jabber-rtt--cancel-send))
+ (unless (derived-mode-p 'jabber-chat-mode)
+ (error "Real Time Text only makes sense in chat buffers"))
+ (when (timerp jabber-rtt-send-timer)
+ (cancel-timer jabber-rtt-send-timer))
+ (setq jabber-rtt-send-timer nil
+ jabber-rtt-send-seq nil
+ jabber-rtt-outgoing-events nil
+ jabber-rtt-send-last-timestamp nil)
+ (jabber-rtt--send-current-text nil)
+ (add-hook 'after-change-functions #'jabber-rtt--queue-update nil t)
+ (add-hook 'jabber-chat-send-hooks #'jabber-rtt--message-sent nil t)))
+
+(defun jabber-rtt--cancel-send ()
+ (when (timerp jabber-rtt-send-timer)
+ (cancel-timer jabber-rtt-send-timer))
+ (setq jabber-rtt-send-seq (1+ jabber-rtt-send-seq))
+ (jabber-send-sexp jabber-buffer-connection
+ `(message ((to . ,jabber-chatting-with)
+ (type . "chat"))
+ (rtt ((xmlns . "urn:xmpp:rtt:0")
+ (seq . ,(number-to-string jabber-rtt-send-seq))
+ (event . "cancel"))
+ nil)))
+ (setq jabber-rtt-send-timer nil
+ jabber-rtt-send-seq nil
+ jabber-rtt-outgoing-events nil
+ jabber-rtt-send-last-timestamp nil))
+
+(defun jabber-rtt--send-current-text (resetp)
+ (let ((text (buffer-substring-no-properties jabber-point-insert (point-max))))
+ ;; This should give us enough room to avoid wrap-arounds, even
+ ;; with just 28 bits...
+ (setq jabber-rtt-send-seq (random 100000))
+ (jabber-send-sexp jabber-buffer-connection
+ `(message ((to . ,jabber-chatting-with)
+ (type . "chat"))
+ (rtt ((xmlns . "urn:xmpp:rtt:0")
+ (seq . ,(number-to-string jabber-rtt-send-seq))
+ (event . ,(if resetp "reset" "new")))
+ (t () ,text))))))
+
+(defun jabber-rtt--queue-update (beg end pre-change-length)
+ (unless (or (< beg jabber-point-insert)
+ (< end jabber-point-insert))
+ (let ((timestamp (current-time)))
+ (when jabber-rtt-send-last-timestamp
+ (let* ((time-difference (time-subtract timestamp jabber-rtt-send-last-timestamp))
+ (interval (truncate (* 1000 (float-time time-difference)))))
+ (when (and (> interval 0)
+ ;; Don't send too long intervals - this should have
+ ;; been sent by our timer already.
+ (< interval 1000))
+ (push `(w ((n . ,(number-to-string interval))) nil)
+ jabber-rtt-outgoing-events))))
+ (setq jabber-rtt-send-last-timestamp timestamp))
+
+ (when (> pre-change-length 0)
+ ;; Some text was deleted. Let's check if we can use a shorter
+ ;; tag:
+ (let ((at-end (= end (point-max)))
+ (erase-one (= pre-change-length 1)))
+ (push `(e (
+ ,@(unless at-end
+ `((p . ,(number-to-string
+ (+ beg
+ (- jabber-point-insert)
+ pre-change-length)))))
+ ,@(unless erase-one
+ `((n . ,(number-to-string pre-change-length))))))
+ jabber-rtt-outgoing-events)))
+
+ (when (/= beg end)
+ ;; Some text was inserted.
+ (let ((text (buffer-substring-no-properties beg end))
+ (at-end (= end (point-max))))
+ (push `(t (
+ ,@(unless at-end
+ `((p . ,(number-to-string (- beg jabber-point-insert))))))
+ ,text)
+ jabber-rtt-outgoing-events)))
+
+ (when (null jabber-rtt-send-timer)
+ (setq jabber-rtt-send-timer
+ (run-with-timer 0.7 nil #'jabber-rtt--send-queued-events (current-buffer))))))
+
+(defun jabber-rtt--send-queued-events (buffer)
+ (with-current-buffer buffer
+ (setq jabber-rtt-send-timer nil)
+ (when jabber-rtt-outgoing-events
+ (let ((event (if jabber-rtt-send-seq "edit" "new")))
+ (setq jabber-rtt-send-seq
+ (if jabber-rtt-send-seq
+ (1+ jabber-rtt-send-seq)
+ (random 100000)))
+ (jabber-send-sexp jabber-buffer-connection
+ `(message ((to . ,jabber-chatting-with)
+ (type . "chat"))
+ (rtt ((xmlns . "urn:xmpp:rtt:0")
+ (seq . ,(number-to-string jabber-rtt-send-seq))
+ (event . ,event))
+ ,@(nreverse jabber-rtt-outgoing-events))))
+ (setq jabber-rtt-outgoing-events nil)))))
+
+(defun jabber-rtt--message-sent (_text _id)
+ ;; We're sending a <body/> element; reset our state
+ (when (timerp jabber-rtt-send-timer)
+ (cancel-timer jabber-rtt-send-timer))
+ (setq jabber-rtt-send-timer nil
+ jabber-rtt-send-seq nil
+ jabber-rtt-outgoing-events nil
+ jabber-rtt-send-last-timestamp nil))
+
(provide 'jabber-rtt)
;;; jabber-rtt.el ends here
commit d1732df73a4c192761ba137a3a6dca1cc8128b9e
Author: Magnus Henoch <mag...@gm...>
Date: Thu Nov 14 10:21:50 2013 +0000
Allow local hooks in jabber-chat-send-hooks
diff --git a/jabber-chat.el b/jabber-chat.el
index 2c15f84..80d214f 100644
--- a/jabber-chat.el
+++ b/jabber-chat.el
@@ -337,8 +337,16 @@ This function is idempotent."
(id . ,id))
(body () ,body))))
;; ...add additional elements...
+ ;; TODO: Once we require Emacs 24.1, use `run-hook-wrapped' instead.
+ ;; That way we don't need to eliminate the "local hook" functionality
+ ;; here.
(dolist (hook jabber-chat-send-hooks)
- (nconc stanza-to-send (funcall hook body id)))
+ (if (eq hook t)
+ ;; Local hook referring to global...
+ (when (local-variable-p 'jabber-chat-send-hooks)
+ (dolist (global-hook (default-value 'jabber-chat-send-hooks))
+ (nconc stanza-to-send (funcall global-hook body id))))
+ (nconc stanza-to-send (funcall hook body id))))
;; ...display it, if it would be displayed.
(when (run-hook-with-args-until-success 'jabber-chat-printers stanza-to-send :local :printp)
(jabber-maybe-print-rare-time
-----------------------------------------------------------------------
Summary of changes:
jabber-chat.el | 10 ++++-
jabber-rtt.el | 139 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 148 insertions(+), 1 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-12 14:52:41
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via b5cb0d640e7771908d4e772625c79c65c756059e (commit)
from 0118504cf7629bbb2d512b0d38625ffb7dd7be28 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit b5cb0d640e7771908d4e772625c79c65c756059e
Author: Magnus Henoch <mag...@gm...>
Date: Tue Nov 12 10:23:57 2013 +0000
Fix error case in jabber-network-connect-async
The `connection-failed' function didn't have access to the variables
`target' and `remaining-targets', since they weren't lexically bound.
diff --git a/jabber-conn.el b/jabber-conn.el
index d03c32d..bdc0cc4 100644
--- a/jabber-conn.el
+++ b/jabber-conn.el
@@ -151,46 +151,47 @@ connection fails."
(labels
((connect
(target remaining-targets)
- (labels ((connection-successful
- (c)
- ;; This mustn't be `fsm-send-sync', because the FSM
- ;; needs to change the sentinel, which cannot be done
- ;; from inside the sentinel.
- (fsm-send fsm (list :connected c)))
- (connection-failed
- (c)
- (message "Couldn't connect to %s:%s" (car target) (cdr target))
- (when c (delete-process c))
- (if remaining-targets
- (progn
- (message
- "Connecting to %s:%s..."
- (caar remaining-targets) (cdar remaining-targets))
- (connect (car remaining-targets) (cdr remaining-targets)))
- (fsm-send fsm :connection-failed))))
- (condition-case nil
- (make-network-process
- :name "jabber"
- :buffer (generate-new-buffer jabber-process-buffer)
- :host (car target) :service (cdr target)
- :coding 'utf-8
- :nowait t
- :sentinel
- (lexical-let ((target target) (remaining-targets remaining-targets))
- (lambda (connection status)
- (cond
- ((string-match "^open" status)
- (connection-successful connection))
- ((string-match "^failed" status)
- (connection-failed connection))
- ((string-match "^deleted" status)
- ;; This happens when we delete a process in the
- ;; "failed" case above.
- nil)
- (t
- (message "Unknown sentinel status `%s'" status))))))
- (error
- (connection-failed nil))))))
+ (lexical-let ((target target) (remaining-targets remaining-targets))
+ (labels ((connection-successful
+ (c)
+ ;; This mustn't be `fsm-send-sync', because the FSM
+ ;; needs to change the sentinel, which cannot be done
+ ;; from inside the sentinel.
+ (fsm-send fsm (list :connected c)))
+ (connection-failed
+ (c)
+ (message "Couldn't connect to %s:%s" (car target) (cdr target))
+ (when c (delete-process c))
+ (if remaining-targets
+ (progn
+ (message
+ "Connecting to %s:%s..."
+ (caar remaining-targets) (cdar remaining-targets))
+ (connect (car remaining-targets) (cdr remaining-targets)))
+ (fsm-send fsm :connection-failed))))
+ (condition-case nil
+ (make-network-process
+ :name "jabber"
+ :buffer (generate-new-buffer jabber-process-buffer)
+ :host (car target) :service (cdr target)
+ :coding 'utf-8
+ :nowait t
+ :sentinel
+ (lexical-let ((target target) (remaining-targets remaining-targets))
+ (lambda (connection status)
+ (cond
+ ((string-match "^open" status)
+ (connection-successful connection))
+ ((string-match "^failed" status)
+ (connection-failed connection))
+ ((string-match "^deleted" status)
+ ;; This happens when we delete a process in the
+ ;; "failed" case above.
+ nil)
+ (t
+ (message "Unknown sentinel status `%s'" status))))))
+ (error
+ (connection-failed nil)))))))
(message "Connecting to %s:%s..." (caar targets) (cdar targets))
(connect (car targets) (cdr targets)))))
-----------------------------------------------------------------------
Summary of changes:
jabber-conn.el | 81 ++++++++++++++++++++++++++++---------------------------
1 files changed, 41 insertions(+), 40 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-05 23:43:14
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, rtt has been created
at ccd6e4a596aba77bf7ba2759068e937c01453d42 (commit)
- Log -----------------------------------------------------------------
commit ccd6e4a596aba77bf7ba2759068e937c01453d42
Author: Magnus Henoch <mag...@gm...>
Date: Tue Nov 5 23:42:57 2013 +0000
XEP-0301: handle wait events
diff --git a/jabber-rtt.el b/jabber-rtt.el
index c7cca9c..44e98bb 100644
--- a/jabber-rtt.el
+++ b/jabber-rtt.el
@@ -35,6 +35,9 @@
(defvar jabber-rtt-pending-events nil)
(make-variable-buffer-local 'jabber-rtt-pending-events)
+(defvar jabber-rtt-timer nil)
+(make-variable-buffer-local 'jabber-rtt-timer)
+
;; Add function last in chain, so a chat buffer is already created.
;;;###autoload
(add-to-list 'jabber-message-chain #'jabber-rtt-handle-message t)
@@ -54,21 +57,15 @@
(cond
((or body (string= event "cancel"))
;; A <body/> element supersedes real time text.
- (when jabber-rtt-ewoc-node
- (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
- (setq jabber-rtt-ewoc-node nil
- jabber-rtt-last-seq nil
- jabber-rtt-message nil
- jabber-rtt-pending-events nil))
+ (jabber-rtt--reset))
((member event '("new" "reset"))
- (when jabber-rtt-ewoc-node
- (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
+ (jabber-rtt--reset)
(setq jabber-rtt-ewoc-node
(ewoc-enter-last jabber-chat-ewoc (list :notice "[typing...]"))
jabber-rtt-last-seq (string-to-number seq)
jabber-rtt-message ""
jabber-rtt-pending-events nil)
- (jabber-rtt--process-actions actions))
+ (jabber-rtt--enqueue-actions actions))
((string= event "edit")
;; TODO: check whether this works properly in 32-bit Emacs
(cond
@@ -77,7 +74,7 @@
(string-to-number seq)))
;; We are in sync.
(setq jabber-rtt-last-seq (string-to-number seq))
- (jabber-rtt--process-actions actions))
+ (jabber-rtt--enqueue-actions actions))
(t
;; TODO: show warning when not in sync
(message "out of sync! %s vs %s"
@@ -86,41 +83,92 @@
;; TODO: handle event="init"
)))))
-(defun jabber-rtt--process-actions (actions)
- (dolist (action actions)
- (case (jabber-xml-node-name action)
- ((t)
- ;; insert text
- (let* ((p (jabber-xml-get-attribute action 'p))
- (position (if p (string-to-number p) (length jabber-rtt-message))))
- (setq position (max position 0))
- (setq position (min position (length jabber-rtt-message)))
- (setf (substring jabber-rtt-message position position)
- (car (jabber-xml-node-children action)))
-
- (ewoc-set-data jabber-rtt-ewoc-node (list :notice (concat "[typing...] " jabber-rtt-message)))
- (let ((inhibit-read-only t))
- (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
- ((e)
- ;; erase text
- (let* ((p (jabber-xml-get-attribute action 'p))
- (position (if p (string-to-number p) (length jabber-rtt-message)))
- (n (jabber-xml-get-attribute action 'n))
- (number (if n (string-to-number n) 1)))
- (setq position (max position 0))
- (setq position (min position (length jabber-rtt-message)))
- (setq number (max number 0))
- (setq number (min number position))
- ;; Now erase the NUMBER characters before POSITION.
- (setf (substring jabber-rtt-message (- position number) position)
- "")
-
- (ewoc-set-data jabber-rtt-ewoc-node (list :notice jabber-rtt-message))
- (let ((inhibit-read-only t))
- (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
- ((w)
- ;; TODO: handle <w/>
- ))))
+(defun jabber-rtt--reset ()
+ (when jabber-rtt-ewoc-node
+ (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
+ (when (timerp jabber-rtt-timer)
+ (cancel-timer jabber-rtt-timer))
+ (setq jabber-rtt-ewoc-node nil
+ jabber-rtt-last-seq nil
+ jabber-rtt-message nil
+ jabber-rtt-pending-events nil
+ jabber-rtt-timer nil))
+
+(defun jabber-rtt--enqueue-actions (new-actions)
+ (setq jabber-rtt-pending-events
+ ;; Ensure that the queue never contains more than 700 ms worth
+ ;; of wait events.
+ (jabber-rtt--fix-waits (append jabber-rtt-pending-events new-actions)))
+ (unless jabber-rtt-timer
+ (jabber-rtt--process-actions (current-buffer))))
+
+(defun jabber-rtt--process-actions (buffer)
+ (with-current-buffer buffer
+ (setq jabber-rtt-timer nil)
+ (catch 'wait
+ (while jabber-rtt-pending-events
+ (let ((action (pop jabber-rtt-pending-events)))
+ (case (jabber-xml-node-name action)
+ ((t)
+ ;; insert text
+ (let* ((p (jabber-xml-get-attribute action 'p))
+ (position (if p (string-to-number p) (length jabber-rtt-message))))
+ (setq position (max position 0))
+ (setq position (min position (length jabber-rtt-message)))
+ (setf (substring jabber-rtt-message position position)
+ (car (jabber-xml-node-children action)))
+
+ (ewoc-set-data jabber-rtt-ewoc-node (list :notice (concat "[typing...] " jabber-rtt-message)))
+ (let ((inhibit-read-only t))
+ (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
+ ((e)
+ ;; erase text
+ (let* ((p (jabber-xml-get-attribute action 'p))
+ (position (if p (string-to-number p) (length jabber-rtt-message)))
+ (n (jabber-xml-get-attribute action 'n))
+ (number (if n (string-to-number n) 1)))
+ (setq position (max position 0))
+ (setq position (min position (length jabber-rtt-message)))
+ (setq number (max number 0))
+ (setq number (min number position))
+ ;; Now erase the NUMBER characters before POSITION.
+ (setf (substring jabber-rtt-message (- position number) position)
+ "")
+
+ (ewoc-set-data jabber-rtt-ewoc-node (list :notice (concat "[typing...] " jabber-rtt-message)))
+ (let ((inhibit-read-only t))
+ (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
+ ((w)
+ (setq jabber-rtt-timer
+ (run-with-timer
+ (/ (string-to-number (jabber-xml-get-attribute action 'n)) 1000.0)
+ nil
+ #'jabber-rtt--process-actions
+ buffer))
+ (throw 'wait nil))))))))
+
+(defun jabber-rtt--fix-waits (actions)
+ ;; Ensure that the sum of all wait events is no more than 700 ms.
+ (let ((sum 0))
+ (dolist (action actions)
+ (when (eq (jabber-xml-node-name action) 'w)
+ (let ((n (jabber-xml-get-attribute action 'n)))
+ (setq n (string-to-number n))
+ (when (>= n 0)
+ (setq sum (+ sum n))))))
+
+ (if (<= sum 700)
+ actions
+ (let ((scale (/ 700.0 sum)))
+ (mapcar
+ (lambda (action)
+ (if (eq (jabber-xml-node-name action) 'w)
+ (let ((n (jabber-xml-get-attribute action 'n)))
+ (setq n (string-to-number n))
+ (setq n (max n 0))
+ `(w ((n . ,(number-to-string (* scale n)))) nil))
+ action))
+ actions)))))
(provide 'jabber-rtt)
;;; jabber-rtt.el ends here
commit 2b55c4ebd07ed40f741e7c10c02d9dc253f45fd3
Author: Magnus Henoch <mag...@gm...>
Date: Tue Nov 5 09:48:20 2013 +0000
Initial implementation of XEP-0301: In-Band Real Time Text
We can receive RTT events. Wait events are not yet supported.
diff --git a/jabber-rtt.el b/jabber-rtt.el
new file mode 100644
index 0000000..c7cca9c
--- /dev/null
+++ b/jabber-rtt.el
@@ -0,0 +1,126 @@
+;;; jabber-rtt.el --- XEP-0301: In-Band Real Time Text
+
+;; Copyright (C) 2013 Magnus Henoch
+
+;; Author: Magnus Henoch <mag...@gm...>
+
+;; 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 3 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, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defvar jabber-rtt-ewoc-node nil)
+(make-variable-buffer-local 'jabber-rtt-ewoc-node)
+
+(defvar jabber-rtt-last-seq nil)
+(make-variable-buffer-local 'jabber-rtt-last-seq)
+
+(defvar jabber-rtt-message nil)
+(make-variable-buffer-local 'jabber-rtt-message)
+
+(defvar jabber-rtt-pending-events nil)
+(make-variable-buffer-local 'jabber-rtt-pending-events)
+
+;; Add function last in chain, so a chat buffer is already created.
+;;;###autoload
+(add-to-list 'jabber-message-chain #'jabber-rtt-handle-message t)
+
+;;;###autoload
+(defun jabber-rtt-handle-message (jc xml-data)
+ ;; We could support this for MUC as well, if useful.
+ (when (and (not (jabber-muc-message-p xml-data))
+ (get-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data 'from))))
+ (with-current-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data 'from))
+ (let* ((rtt (jabber-xml-path xml-data '(("urn:xmpp:rtt:0" . "rtt"))))
+ (body (jabber-xml-path xml-data '(body)))
+ (seq (when rtt (jabber-xml-get-attribute rtt 'seq)))
+ (event (when rtt (or (jabber-xml-get-attribute rtt 'event) "edit")))
+ (actions (when rtt (jabber-xml-node-children rtt)))
+ (inhibit-read-only t))
+ (cond
+ ((or body (string= event "cancel"))
+ ;; A <body/> element supersedes real time text.
+ (when jabber-rtt-ewoc-node
+ (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
+ (setq jabber-rtt-ewoc-node nil
+ jabber-rtt-last-seq nil
+ jabber-rtt-message nil
+ jabber-rtt-pending-events nil))
+ ((member event '("new" "reset"))
+ (when jabber-rtt-ewoc-node
+ (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
+ (setq jabber-rtt-ewoc-node
+ (ewoc-enter-last jabber-chat-ewoc (list :notice "[typing...]"))
+ jabber-rtt-last-seq (string-to-number seq)
+ jabber-rtt-message ""
+ jabber-rtt-pending-events nil)
+ (jabber-rtt--process-actions actions))
+ ((string= event "edit")
+ ;; TODO: check whether this works properly in 32-bit Emacs
+ (cond
+ ((and jabber-rtt-last-seq
+ (equal (1+ jabber-rtt-last-seq)
+ (string-to-number seq)))
+ ;; We are in sync.
+ (setq jabber-rtt-last-seq (string-to-number seq))
+ (jabber-rtt--process-actions actions))
+ (t
+ ;; TODO: show warning when not in sync
+ (message "out of sync! %s vs %s"
+ seq jabber-rtt-last-seq))
+ ))
+ ;; TODO: handle event="init"
+ )))))
+
+(defun jabber-rtt--process-actions (actions)
+ (dolist (action actions)
+ (case (jabber-xml-node-name action)
+ ((t)
+ ;; insert text
+ (let* ((p (jabber-xml-get-attribute action 'p))
+ (position (if p (string-to-number p) (length jabber-rtt-message))))
+ (setq position (max position 0))
+ (setq position (min position (length jabber-rtt-message)))
+ (setf (substring jabber-rtt-message position position)
+ (car (jabber-xml-node-children action)))
+
+ (ewoc-set-data jabber-rtt-ewoc-node (list :notice (concat "[typing...] " jabber-rtt-message)))
+ (let ((inhibit-read-only t))
+ (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
+ ((e)
+ ;; erase text
+ (let* ((p (jabber-xml-get-attribute action 'p))
+ (position (if p (string-to-number p) (length jabber-rtt-message)))
+ (n (jabber-xml-get-attribute action 'n))
+ (number (if n (string-to-number n) 1)))
+ (setq position (max position 0))
+ (setq position (min position (length jabber-rtt-message)))
+ (setq number (max number 0))
+ (setq number (min number position))
+ ;; Now erase the NUMBER characters before POSITION.
+ (setf (substring jabber-rtt-message (- position number) position)
+ "")
+
+ (ewoc-set-data jabber-rtt-ewoc-node (list :notice jabber-rtt-message))
+ (let ((inhibit-read-only t))
+ (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
+ ((w)
+ ;; TODO: handle <w/>
+ ))))
+
+(provide 'jabber-rtt)
+;;; jabber-rtt.el ends here
-----------------------------------------------------------------------
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-11-03 19:12:43
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 0118504cf7629bbb2d512b0d38625ffb7dd7be28 (commit)
from 8257959a069b51a3bdaba5e63cb7ebf0be9b961f (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 0118504cf7629bbb2d512b0d38625ffb7dd7be28
Author: Magnus Henoch <mag...@gm...>
Date: Sun Nov 3 19:12:16 2013 +0000
Catch errors in jabber-network-connect-async
DNS resolution errors from make-network-process are signalled
immediately, and not passed to the sentinel function. Make sure that
we pass such errors along, so DNS errors aren't buried in the
*fsm-debug* buffer.
diff --git a/jabber-conn.el b/jabber-conn.el
index 307051b..d03c32d 100644
--- a/jabber-conn.el
+++ b/jabber-conn.el
@@ -151,37 +151,46 @@ connection fails."
(labels
((connect
(target remaining-targets)
- (make-network-process
- :name "jabber"
- :buffer (generate-new-buffer jabber-process-buffer)
- :host (car target) :service (cdr target)
- :coding 'utf-8
- :nowait t
- :sentinel
- (lexical-let ((target target) (remaining-targets remaining-targets))
- (lambda (connection status)
- (cond
- ((string-match "^open" status)
- ;; This mustn't be `fsm-send-sync', because the FSM
- ;; needs to change the sentinel, which cannot be done
- ;; from inside the sentinel.
- (fsm-send fsm (list :connected connection)))
- ((string-match "^failed" status)
- (message "Couldn't connect to %s:%s" (car target) (cdr target))
- (delete-process connection)
- (if remaining-targets
- (progn
- (message
- "Connecting to %s:%s..."
- (caar remaining-targets) (cdar remaining-targets))
- (connect (car remaining-targets) (cdr remaining-targets)))
- (fsm-send fsm :connection-failed)))
- ((string-match "^deleted" status)
- ;; This happens when we delete a process in the
- ;; "failed" case above.
- nil)
- (t
- (message "Unknown sentinel status `%s'" status))))))))
+ (labels ((connection-successful
+ (c)
+ ;; This mustn't be `fsm-send-sync', because the FSM
+ ;; needs to change the sentinel, which cannot be done
+ ;; from inside the sentinel.
+ (fsm-send fsm (list :connected c)))
+ (connection-failed
+ (c)
+ (message "Couldn't connect to %s:%s" (car target) (cdr target))
+ (when c (delete-process c))
+ (if remaining-targets
+ (progn
+ (message
+ "Connecting to %s:%s..."
+ (caar remaining-targets) (cdar remaining-targets))
+ (connect (car remaining-targets) (cdr remaining-targets)))
+ (fsm-send fsm :connection-failed))))
+ (condition-case nil
+ (make-network-process
+ :name "jabber"
+ :buffer (generate-new-buffer jabber-process-buffer)
+ :host (car target) :service (cdr target)
+ :coding 'utf-8
+ :nowait t
+ :sentinel
+ (lexical-let ((target target) (remaining-targets remaining-targets))
+ (lambda (connection status)
+ (cond
+ ((string-match "^open" status)
+ (connection-successful connection))
+ ((string-match "^failed" status)
+ (connection-failed connection))
+ ((string-match "^deleted" status)
+ ;; This happens when we delete a process in the
+ ;; "failed" case above.
+ nil)
+ (t
+ (message "Unknown sentinel status `%s'" status))))))
+ (error
+ (connection-failed nil))))))
(message "Connecting to %s:%s..." (caar targets) (cdar targets))
(connect (car targets) (cdr targets)))))
-----------------------------------------------------------------------
Summary of changes:
jabber-conn.el | 71 +++++++++++++++++++++++++++++++------------------------
1 files changed, 40 insertions(+), 31 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-10-18 20:32:21
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 8257959a069b51a3bdaba5e63cb7ebf0be9b961f (commit)
via 7b4c286b5be84d5178cf6d712eefec4a57c18eb3 (commit)
from 993b1d7fbeddc03d0d0e187fe7c8b7354cc6b330 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 8257959a069b51a3bdaba5e63cb7ebf0be9b961f
Author: Magnus Henoch <mag...@gm...>
Date: Fri Oct 18 21:32:01 2013 +0100
Move history files into user-emacs-directory; default to per-contact history
Avoid breaking existing installations: if the global history file
already exists, use it; if the file/directory exists at the old
location, keep using it.
diff --git a/jabber-history.el b/jabber-history.el
index de9224d..3b2bcb0 100644
--- a/jabber-history.el
+++ b/jabber-history.el
@@ -49,40 +49,46 @@ Default is nil, cause MUC logging may be i/o-intensive."
:type 'boolean
:group 'jabber-history)
-(defcustom jabber-use-global-history t
- "Indicate whether Emacs Jabber should use a global file for
- store messages. If non-nil, jabber-global-history-filename is
- used, otherwise, messages are stored in per-user files under
- the jabber-history-dir directory."
- :type 'boolean
- :group 'jabber-history)
-
-(defcustom jabber-history-dir "~/.emacs-jabber"
+(defcustom jabber-history-dir
+ (locate-user-emacs-file "jabber-history" ".emacs-jabber")
"Base directory where per-contact history files are stored.
- Used only when jabber-use-global-history is not true."
+Used only when `jabber-use-global-history' is nil."
:type 'directory
:group 'jabber-history)
-(defcustom jabber-global-history-filename "~/.jabber_global_message_log"
- "Global file where all messages are logged. Used when
- jabber-use-global-history is non-nil."
+(defcustom jabber-global-history-filename
+ (locate-user-emacs-file "jabber-global-message-log" ".jabber_global_message_log")
+ "Global file where all messages are logged.
+Used when `jabber-use-global-history' is non-nil."
:type 'file
:group 'jabber-history)
+(defcustom jabber-use-global-history
+ ;; Using a global history file by default was a bad idea. Let's
+ ;; default to per-user files unless the global history file already
+ ;; exists, to avoid breaking existing installations.
+ (file-exists-p jabber-global-history-filename)
+ "Whether to use a global file for message history.
+If non-nil, `jabber-global-history-filename' is used, otherwise,
+messages are stored in per-user files under the
+`jabber-history-dir' directory."
+ :type 'boolean
+ :group 'jabber-history)
+
(defcustom jabber-history-enable-rotation nil
"Whether history files should be renamed when reach
- jabber-history-size-limit kilobytes. If nil, history files
- will grow indefinitely, otherwise they'll be renamed to
- <history-file>-<number>, where <number> is 1 or the smallest
- number after the last rotation."
+`jabber-history-size-limit' kilobytes. If nil, history files
+will grow indefinitely, otherwise they'll be renamed to
+<history-file>-<number>, where <number> is 1 or the smallest
+number after the last rotation."
:type 'boolean
:group 'jabber-history)
(defcustom jabber-history-size-limit 1024
- "Maximum history file size in kilobytes. When history file
- reaches this limit, it is renamed to <history-file>-<number>,
- where <number> is 1 or the smallest number after the last
- rotation."
+ "Maximum history file size in kilobytes.
+When history file reaches this limit, it is renamed to
+<history-file>-<number>, where <number> is 1 or the smallest
+number after the last rotation."
:type 'integer
:group 'jabber-history)
diff --git a/jabber.texi b/jabber.texi
index 7d65fca..07419e3 100644
--- a/jabber.texi
+++ b/jabber.texi
@@ -1443,16 +1443,18 @@ saving (by default, all groups rolled down). Also note that at now,
@vindex jabber-log-lines-to-keep
If you want a record of messages sent and received, set
-@code{jabber-history-enabled} to t. If you also want record MUC groupchat
-messages, set @code{jabber-history-muc-enabled} to t. By default all messages will
-be saved to a global history file specified by
-@code{jabber-global-history-filename}
-(@file{~/.jabber_global_message_log} by default). If you prefer to
-store your chats' history in per-contact files, you can set
-@code{jabber-use-global-history} to @code{nil}. When using
-per-contact history, files are named by the contact JID and saved
-under the directory specified by the variable
-@code{jabber-history-dir} (default is @file{~/.emacs-jabber}).
+@code{jabber-history-enabled} to t. If you also want record MUC
+groupchat messages, set @code{jabber-history-muc-enabled} to t.
+Messages will be saved in one file per contact in the directory
+specified by the variable @code{jabber-history-dir} (the default is
+@file{~/.emacs.d/jabber-history}). If you prefer to store messages
+for all contacts in a single file, set
+@code{jabber-use-global-history} to @code{t} and set
+@code{jabber-global-history-filename} as required.@footnote{Using a
+global history file used to be the default. If the file specified by
+@code{jabber-global-history-filename} exists,
+@code{jabber-use-global-history} will default to @code{t} to support
+existing installations.}
When you open a new chat buffer and have entries in your history file,
the last few messages you recently exchanged with the contact in
commit 7b4c286b5be84d5178cf6d712eefec4a57c18eb3
Author: Magnus Henoch <mag...@gm...>
Date: Fri Oct 18 20:16:51 2013 +0100
Put avatar cache inside user-emacs-directory
Avoid polluting the user's home directory.
diff --git a/jabber-avatar.el b/jabber-avatar.el
index 3f0d73a..8a956ba 100644
--- a/jabber-avatar.el
+++ b/jabber-avatar.el
@@ -41,7 +41,8 @@
"Avatar related settings"
:group 'jabber)
-(defcustom jabber-avatar-cache-directory "~/.jabber-avatars/"
+(defcustom jabber-avatar-cache-directory
+ (locate-user-emacs-file "jabber-avatar-cache" ".jabber-avatars")
"Directory to use for cached avatars"
:group 'jabber-avatar
:type 'directory)
@@ -159,7 +160,7 @@ If there is no cached image, return nil."
(filename (expand-file-name id jabber-avatar-cache-directory))
(buffer (create-file-buffer filename)))
(unless (file-directory-p jabber-avatar-cache-directory)
- (make-directory jabber-avatar-cache-directory))
+ (make-directory jabber-avatar-cache-directory t))
(if (file-exists-p filename)
(when jabber-avatar-verbose
diff --git a/jabber.texi b/jabber.texi
index 775311b..7d65fca 100644
--- a/jabber.texi
+++ b/jabber.texi
@@ -1063,7 +1063,9 @@ behave incorrectly if the image is not in a format supported by Emacs.)
Avatars are cached in the directory specified by
@code{jabber-avatar-cache-directory}, by default
-@file{~/.jabber-avatars/}. The cache is never cleaned, so you might
+@file{~/.emacs.d/jabber-avatar-cache/}.@footnote{The default directory
+used to be @file{~/.jabber-avatars}. If this directory already
+exists, it will be used.} The cache is never cleaned, so you might
want to do that yourself from time to time.
@node Time queries, Useful features, Avatars, Top
-----------------------------------------------------------------------
Summary of changes:
jabber-avatar.el | 5 +++--
jabber-history.el | 48 +++++++++++++++++++++++++++---------------------
jabber.texi | 26 +++++++++++++++-----------
3 files changed, 45 insertions(+), 34 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-09-06 09:47:20
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 993b1d7fbeddc03d0d0e187fe7c8b7354cc6b330 (commit)
from 350ef23aaac0242e470fd8fac3a447b7df77f293 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 993b1d7fbeddc03d0d0e187fe7c8b7354cc6b330
Author: Magnus Henoch <mag...@gm...>
Date: Fri Sep 6 10:46:51 2013 +0100
Accept roster push from server JID
That is what Facebook does.
diff --git a/jabber-presence.el b/jabber-presence.el
index 461b6df..7fa9b19 100644
--- a/jabber-presence.el
+++ b/jabber-presence.el
@@ -49,13 +49,15 @@ CLOSURE-DATA should be 'initial if initial roster push, nil otherwise."
(resource (plist-get (fsm-get-state-data jc) :resource))
new-items changed-items deleted-items)
;; Perform sanity check on "from" attribute: it should be either absent
- ;; or match our own JID.
+ ;; match our own JID, or match the server's JID (the latter is what
+ ;; Facebook does).
(if (not (or (null from)
+ (string= from server)
(string= from (concat username "@" server))
(string= from (concat username "@" server "/" resource))))
- (message "Roster push with invalid \"from\": \"%s\" (expected \"%s@%s\" or \"%s@%s/%s\")"
+ (message "Roster push with invalid \"from\": \"%s\" (expected \"%s\", \"%s@%s\" or \"%s@%s/%s\")"
from
- username server username server resource)
+ server username server username server resource)
(dolist (item (jabber-xml-get-children (car (jabber-xml-get-children xml-data 'query)) 'item))
(let (roster-item
-----------------------------------------------------------------------
Summary of changes:
jabber-presence.el | 8 +++++---
1 files changed, 5 insertions(+), 3 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-08-27 09:10:39
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via 350ef23aaac0242e470fd8fac3a447b7df77f293 (commit)
from de83262ef8db3bd318de14df26ea6392f2428fc5 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 350ef23aaac0242e470fd8fac3a447b7df77f293
Author: Magnus Henoch <mag...@gm...>
Date: Tue Aug 27 10:09:56 2013 +0100
Don't require jabber-autoloads
Requiring jabber-autoloads from .emacs or a similar location is the
only supported way to load jabber.el, and it's also the way it gets
done when installing it as a package.
diff --git a/jabber-activity.el b/jabber-activity.el
index ea32994..9f4bec9 100644
--- a/jabber-activity.el
+++ b/jabber-activity.el
@@ -42,7 +42,6 @@
(require 'jabber-core)
(require 'jabber-alert)
(require 'jabber-util)
-(require 'jabber-autoloads)
(require 'jabber-muc-nick-completion) ;we need jabber-muc-looks-like-personal-p
(require 'cl)
diff --git a/jabber-ahc-presence.el b/jabber-ahc-presence.el
index de9b596..063d3b6 100644
--- a/jabber-ahc-presence.el
+++ b/jabber-ahc-presence.el
@@ -20,7 +20,6 @@
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(require 'jabber-ahc)
-(require 'jabber-autoloads)
(defconst jabber-ahc-presence-node "http://jabber.org/protocol/rc#set-status"
"Node used by jabber-ahc-presence")
diff --git a/jabber-ahc.el b/jabber-ahc.el
index 3999317..e201b7d 100644
--- a/jabber-ahc.el
+++ b/jabber-ahc.el
@@ -21,7 +21,6 @@
(require 'jabber-disco)
(require 'jabber-widget)
-(require 'jabber-autoloads)
(defvar jabber-ahc-sessionid nil
"session id of Ad-Hoc Command session")
diff --git a/jabber-alert.el b/jabber-alert.el
index 9aaa750..105c5f4 100644
--- a/jabber-alert.el
+++ b/jabber-alert.el
@@ -20,7 +20,6 @@
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(require 'jabber-util)
-(require 'jabber-autoloads)
(require 'cl)
diff --git a/jabber-bookmarks.el b/jabber-bookmarks.el
index 60562b1..5a9f39f 100644
--- a/jabber-bookmarks.el
+++ b/jabber-bookmarks.el
@@ -20,7 +20,6 @@
(require 'jabber-private)
(require 'jabber-widget)
-(require 'jabber-autoloads)
(require 'cl)
diff --git a/jabber-chat.el b/jabber-chat.el
index a71328d..2c15f84 100644
--- a/jabber-chat.el
+++ b/jabber-chat.el
@@ -21,7 +21,6 @@
(require 'jabber-core)
(require 'jabber-chatbuffer)
(require 'jabber-history)
-(require 'jabber-autoloads)
(require 'jabber-menu) ;we need jabber-jid-chat-menu
(require 'ewoc)
(eval-when-compile (require 'cl))
diff --git a/jabber-chatstates.el b/jabber-chatstates.el
index a32b656..8b82171 100644
--- a/jabber-chatstates.el
+++ b/jabber-chatstates.el
@@ -22,7 +22,6 @@
;; - Currently only active/composing notifications are /sent/ though all 5
;; notifications are handled on receipt.
-(require 'jabber-autoloads)
(require 'cl)
(defgroup jabber-chatstates nil
diff --git a/jabber-events.el b/jabber-events.el
index 84df937..f78030a 100644
--- a/jabber-events.el
+++ b/jabber-events.el
@@ -19,7 +19,6 @@
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-(require 'jabber-autoloads)
(require 'cl)
(defgroup jabber-events nil
diff --git a/jabber-history.el b/jabber-history.el
index e4a8580..de9224d 100644
--- a/jabber-history.el
+++ b/jabber-history.el
@@ -33,7 +33,6 @@
(require 'jabber-core)
(require 'jabber-util)
-(require 'jabber-autoloads)
(defgroup jabber-history nil "Customization options for Emacs
Jabber history files."
diff --git a/jabber-menu.el b/jabber-menu.el
index 9bfadd8..c5cf9a8 100644
--- a/jabber-menu.el
+++ b/jabber-menu.el
@@ -20,7 +20,6 @@
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(require 'jabber-util)
-(require 'jabber-autoloads)
(eval-when-compile (require 'cl))
;;;###autoload
diff --git a/jabber-muc.el b/jabber-muc.el
index 606b548..45a7bd8 100644
--- a/jabber-muc.el
+++ b/jabber-muc.el
@@ -23,7 +23,6 @@
(require 'jabber-chat)
(require 'jabber-widget)
(require 'jabber-newdisco)
-(require 'jabber-autoloads)
(require 'jabber-muc-nick-coloring)
(require 'cl)
diff --git a/jabber-presence.el b/jabber-presence.el
index 55325d2..461b6df 100644
--- a/jabber-presence.el
+++ b/jabber-presence.el
@@ -25,7 +25,6 @@
(require 'jabber-util)
(require 'jabber-menu)
(require 'jabber-muc)
-(require 'jabber-autoloads)
(defvar jabber-presence-element-functions nil
"List of functions returning extra elements for <presence/> stanzas.
diff --git a/jabber.el b/jabber.el
index 1046a04..ca34584 100644
--- a/jabber.el
+++ b/jabber.el
@@ -155,8 +155,6 @@ configure a Google Talk account like this:
(require 'jabber-awesome)
(require 'jabber-libnotify)
-(require 'jabber-autoloads)
-
;;;###autoload
(defvar *jabber-current-status* nil
"the users current presence status")
-----------------------------------------------------------------------
Summary of changes:
jabber-activity.el | 1 -
jabber-ahc-presence.el | 1 -
jabber-ahc.el | 1 -
jabber-alert.el | 1 -
jabber-bookmarks.el | 1 -
jabber-chat.el | 1 -
jabber-chatstates.el | 1 -
jabber-events.el | 1 -
jabber-history.el | 1 -
jabber-menu.el | 1 -
jabber-muc.el | 1 -
jabber-presence.el | 1 -
jabber.el | 2 --
13 files changed, 0 insertions(+), 14 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-08-25 23:16:21
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via de83262ef8db3bd318de14df26ea6392f2428fc5 (commit)
via bdae54a9c1571a36af385a4ea1016549273e5c5c (commit)
from a50b9f490254a350b258bada5866acfb69d34a31 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit de83262ef8db3bd318de14df26ea6392f2428fc5
Author: Magnus Henoch <mag...@gm...>
Date: Sun Aug 25 23:56:13 2013 +0100
Disable menu items as appropriate
If there are no connections, disable "Disconnect".
If there are no unread messages, disable "Next unread message".
This also ensures that the functions are loaded when the user might
try to activate the menu item.
diff --git a/jabber-menu.el b/jabber-menu.el
index fa8a9f3..9bfadd8 100644
--- a/jabber-menu.el
+++ b/jabber-menu.el
@@ -32,11 +32,13 @@
(define-key-after map
[jabber-menu-nextmsg]
- '("Next unread message" . jabber-activity-switch-to))
+ '(menu-item "Next unread message" jabber-activity-switch-to
+ :enable (bound-and-true-p jabber-activity-jids)))
(define-key-after map
[jabber-menu-disconnect]
- '("Disconnect" . jabber-disconnect))
+ '(menu-item "Disconnect" jabber-disconnect
+ :enable (bound-and-true-p jabber-connections)))
(define-key-after map
[jabber-menu-roster]
@@ -44,8 +46,9 @@
(define-key-after map
[jabber-menu-status]
- (cons "Set Status" (make-sparse-keymap "set-status")))
-
+ `(menu-item "Set Status" ,(make-sparse-keymap "set-status")
+ :enable (bound-and-true-p jabber-connections)))
+
(define-key map
[jabber-menu-status jabber-menu-status-chat]
'("Chatty" .
commit bdae54a9c1571a36af385a4ea1016549273e5c5c
Author: Magnus Henoch <mag...@gm...>
Date: Sun Aug 25 23:40:12 2013 +0100
Reorder menu items; add separator
I put commands used to connect or while connected first, and
meta-commands (Customize and Help) in a second section.
diff --git a/jabber-menu.el b/jabber-menu.el
index 1135c0f..fa8a9f3 100644
--- a/jabber-menu.el
+++ b/jabber-menu.el
@@ -26,31 +26,23 @@
;;;###autoload
(defvar jabber-menu
(let ((map (make-sparse-keymap "jabber-menu")))
- (define-key map
+ (define-key-after map
[jabber-menu-connect]
'("Connect" . jabber-connect-all))
- (define-key map
+ (define-key-after map
[jabber-menu-nextmsg]
'("Next unread message" . jabber-activity-switch-to))
- (define-key map
+ (define-key-after map
[jabber-menu-disconnect]
'("Disconnect" . jabber-disconnect))
- (define-key map
+ (define-key-after map
[jabber-menu-roster]
'("Switch to roster" . jabber-switch-to-roster-buffer))
- (define-key map
- [jabber-menu-customize]
- '("Customize" . jabber-customize))
-
- (define-key map
- [jabber-menu-info]
- '("Help" . jabber-info))
-
- (define-key map
+ (define-key-after map
[jabber-menu-status]
(cons "Set Status" (make-sparse-keymap "set-status")))
@@ -80,6 +72,18 @@
[jabber-menu-status jabber-menu-status-online]
'("Online" . jabber-send-default-presence))
+ (define-key-after map
+ [separator]
+ '(menu-item "--"))
+
+ (define-key-after map
+ [jabber-menu-customize]
+ '("Customize" . jabber-customize))
+
+ (define-key-after map
+ [jabber-menu-info]
+ '("Help" . jabber-info))
+
map))
;;;###autoload
-----------------------------------------------------------------------
Summary of changes:
jabber-menu.el | 41 ++++++++++++++++++++++++-----------------
1 files changed, 24 insertions(+), 17 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-08-25 14:49:17
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via a50b9f490254a350b258bada5866acfb69d34a31 (commit)
from c335fc5b6a8c60d0a4969842e1e3d876f21dda79 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a50b9f490254a350b258bada5866acfb69d34a31
Author: Magnus Henoch <mag...@gm...>
Date: Sun Aug 25 15:49:06 2013 +0100
Display menu by default if user installed the package
If the user installed the package into `package-user-dir' (as opposed
to a system-wide installation), it should be fine to display a Jabber
menu by default (which still can be turned off).
diff --git a/jabber-menu.el b/jabber-menu.el
index 47957ee..1135c0f 100644
--- a/jabber-menu.el
+++ b/jabber-menu.el
@@ -87,12 +87,12 @@
"Decide whether the \"Jabber\" menu is displayed in the menu bar.
If t, always display.
If nil, never display.
-If maybe, display if any of `jabber-account-list' or `jabber-connections'
-is non-nil."
+If maybe, display if jabber.el is installed under `package-user-dir', or
+if any of `jabber-account-list' or `jabber-connections' is non-nil."
:group 'jabber
:type '(choice (const :tag "Never" nil)
(const :tag "Always" t)
- (const :tag "When any accounts have been configured or connected" maybe)))
+ (const :tag "When installed by user, or when any accounts have been configured or connected" maybe)))
(defun jabber-menu (&optional remove)
"Put \"Jabber\" menu on menubar.
@@ -109,10 +109,21 @@ With prefix argument, remove it."
(define-key-after (lookup-key global-map [menu-bar])
[jabber-menu]
(list 'menu-item "Jabber" jabber-menu
- :visible '(or (eq jabber-display-menu t)
- (and (eq jabber-display-menu 'maybe)
- (or jabber-account-list
- (bound-and-true-p jabber-connections))))))
+ :visible
+ ;; If the package was installed by the user personally, it's
+ ;; probably ok to "clutter" the menu bar with a Jabber menu.
+ (let ((user-installed-package
+ (and (bound-and-true-p package-user-dir)
+ (string=
+ (file-name-as-directory
+ (expand-file-name ".." (file-name-directory load-file-name)))
+ (file-name-as-directory
+ (expand-file-name package-user-dir))))))
+ `(or (eq jabber-display-menu t)
+ (and (eq jabber-display-menu 'maybe)
+ (or ,user-installed-package
+ jabber-account-list
+ (bound-and-true-p jabber-connections)))))))
(defvar jabber-jid-chat-menu nil
"Menu items for chat menu")
-----------------------------------------------------------------------
Summary of changes:
jabber-menu.el | 25 ++++++++++++++++++-------
1 files changed, 18 insertions(+), 7 deletions(-)
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-07-27 20:18:26
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via c335fc5b6a8c60d0a4969842e1e3d876f21dda79 (commit)
from c38945c00e471059c8cfe9dade577df1f4e58e35 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit c335fc5b6a8c60d0a4969842e1e3d876f21dda79
Author: Magnus Henoch <mag...@gm...>
Date: Sat Jul 27 20:00:50 2013 +0100
configure.ac to read version number from jabber-ourversion.el
...instead of the other way around. This should make it possible to
build an ELPA-style package straight out of Git without running
autoconf, while we'd still be able to build tarballs through automake.
diff --git a/Makefile.am b/Makefile.am
index 47f03f8..bf9bd01 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -22,11 +22,11 @@ jabber-time.el jabber-truncate.el jabber-util.el \
jabber-vcard-avatars.el jabber-vcard.el jabber-version.el \
jabber-watch.el jabber-widget.el jabber-wmii.el jabber-xmessage.el \
jabber-muc-nick-coloring.el \
-jabber-xml.el jabber.el srv.el jabber-tmux.el
+jabber-xml.el jabber.el srv.el jabber-tmux.el jabber-ourversion.el
compat_lisp_sources = jabber-fallback-lib/hexrgb.el
-dist_lisp_LISP=$(my_lisp_sources) $(compat_lisp_sources) jabber-autoloads.el jabber-ourversion.el
+dist_lisp_LISP=$(my_lisp_sources) $(compat_lisp_sources) jabber-autoloads.el
MAINTAINERCLEANFILES=jabber-autoloads.el
EXTRA_DIST = jabber-pkg.el.in
diff --git a/configure.ac b/configure.ac
index b97e7b1..bc7d3b7 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,9 +1,14 @@
-AC_INIT([jabber.el], [0.8.92], [ema...@li...], [emacs-jabber])
+AC_INIT([jabber.el],
+ m4_esyscmd_s([sed -ne 's/^(defconst jabber-version "\(.*\)"$/\1/p' jabber-ourversion.el]),
+ [ema...@li...],
+ [emacs-jabber])
AC_CONFIG_AUX_DIR([build-aux])
dnl Need automake 1.11 for dist-xz option
AM_INIT_AUTOMAKE([1.11 -Wall -Werror foreign dist-bzip2 dist-xz dist-zip])
AC_CONFIG_MACRO_DIR([m4])
+AC_SUBST([CONFIG_STATUS_DEPENDENCIES], ['$(top_srcdir)/jabber-ourversion.el'])
+
AM_PATH_LISPDIR
AS_IF([test "$EMACS" = no], [AC_MSG_ERROR([cannot find Emacs])])
@@ -14,5 +19,5 @@ AM_CONDITIONAL(GCONF_SCHEMAS_INSTALL, false)
m4_ifndef([AM_GCONF_SOURCE_2], [m4_defun([AM_GCONF_SOURCE_2])])
AM_GCONF_SOURCE_2
-AC_CONFIG_FILES([Makefile tests/Makefile gconf/Makefile jabber-ourversion.el])
+AC_CONFIG_FILES([Makefile tests/Makefile gconf/Makefile])
AC_OUTPUT
diff --git a/jabber-ourversion.el b/jabber-ourversion.el
new file mode 100644
index 0000000..b722cc4
--- /dev/null
+++ b/jabber-ourversion.el
@@ -0,0 +1,8 @@
+;; jabber-ourversion.el. Holds the version number in a format that
+;; configure.ac can read.
+
+;; On the following line, only change the part between double quotes:
+(defconst jabber-version "0.8.92"
+ "version returned to those who query us")
+
+(provide 'jabber-ourversion)
diff --git a/jabber-ourversion.el.in b/jabber-ourversion.el.in
deleted file mode 100644
index 742e50c..0000000
--- a/jabber-ourversion.el.in
+++ /dev/null
@@ -1,7 +0,0 @@
-;; @configure_input@
-
-;; This value gets updated automatically when configure.ac is changed.
-(defconst jabber-version "@PACKAGE_VERSION@"
- "version returned to those who query us")
-
-(provide 'jabber-ourversion)
-----------------------------------------------------------------------
Summary of changes:
Makefile.am | 4 ++--
configure.ac | 9 +++++++--
jabber-ourversion.el | 8 ++++++++
jabber-ourversion.el.in | 7 -------
4 files changed, 17 insertions(+), 11 deletions(-)
create mode 100644 jabber-ourversion.el
delete mode 100644 jabber-ourversion.el.in
hooks/post-receive
--
emacs-jabber
|
|
From: Magnus H. <leg...@us...> - 2013-07-27 18:11:07
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, master has been updated
via c38945c00e471059c8cfe9dade577df1f4e58e35 (commit)
from c6c3af7f967901d6a8fb4ad70671bb5c5365b4bd (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit c38945c00e471059c8cfe9dade577df1f4e58e35
Author: Magnus Henoch <mag...@gm...>
Date: Sat Jul 27 19:10:15 2013 +0100
* jabber-keepalive.el (jabber-whitespace-ping-do): Ignore errors.
Sometimes this fails because the connection is closed. Not sure
exactly why this happens, but the sentinel function should discover
the lost connection anyway, and having an error signalled in a timer
function doesn't help anyone.
diff --git a/jabber-keepalive.el b/jabber-keepalive.el
index 2ce41d6..33297a6 100644
--- a/jabber-keepalive.el
+++ b/jabber-keepalive.el
@@ -169,7 +169,7 @@ accounts."
(defun jabber-whitespace-ping-do ()
(dolist (c jabber-connections)
- (jabber-send-string c " ")))
+ (ignore-errors (jabber-send-string c " "))))
(provide 'jabber-keepalive)
-----------------------------------------------------------------------
Summary of changes:
jabber-keepalive.el | 2 +-
1 files changed, 1 insertions(+), 1 deletions(-)
hooks/post-receive
--
emacs-jabber
|
