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...> - 2018-09-27 23:29:03
|
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 discards c33196772075e6c6ca1dea3ae7bb33094138507a (commit) discards 2ef76cff4a5a932cf17dc6107a0c5adee806081e (commit) via fff33826f42e040dad7ef64ea312d85215d3b0a1 (commit) via 7fb313c259153dc6af6adebb359e11130f12259f (commit) via 3de7fb40ab9c82ada2a4b5f364a2417345953050 (commit) via 562e503274a38dfcc1ea3186e0939df9d869cfc3 (commit) This update added new revisions after undoing existing revisions. That is to say, the old revision is not a strict subset of the new revision. This situation occurs when you --force push a change and generate a repository containing something like this: * -- * -- B -- O -- O -- O (c33196772075e6c6ca1dea3ae7bb33094138507a) \ N -- N -- N (fff33826f42e040dad7ef64ea312d85215d3b0a1) When this happens we assume that you've already had alert emails for all of the O revisions, and so we here report only the revisions in the N branch from the common base, B. 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 fff33826f42e040dad7ef64ea312d85215d3b0a1 Author: Magnus Henoch <mag...@gm...> Date: Fri Sep 28 00:20:15 2018 +0100 Use srv.el from package repository srv.el is now a separate package in MELPA, so let's depend on that. Keep a copy in jabber-fallback-lib for the time being. diff --git a/Makefile.am b/Makefile.am index 5eed578..7df29d0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -23,9 +23,10 @@ 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-ourversion.el +jabber-xml.el jabber.el jabber-tmux.el jabber-ourversion.el -compat_lisp_sources = jabber-fallback-lib/hexrgb.el jabber-fallback-lib/fsm.el +compat_lisp_sources = jabber-fallback-lib/hexrgb.el jabber-fallback-lib/fsm.el \ + jabber-fallback-lib/srv.el dist_lisp_LISP=$(my_lisp_sources) $(compat_lisp_sources) jabber-autoloads.el MAINTAINERCLEANFILES=jabber-autoloads.el diff --git a/jabber-conn.el b/jabber-conn.el index 6a4c2d5..ab88a89 100644 --- a/jabber-conn.el +++ b/jabber-conn.el @@ -36,7 +36,16 @@ (ignore-errors (require 'starttls)) -(require 'srv) +(eval-and-compile + (or (ignore-errors (require 'srv)) + (ignore-errors + (let ((load-path (cons (expand-file-name + "jabber-fallback-lib" + (file-name-directory (locate-library "jabber"))) + load-path))) + (require 'srv))) + (error + "srv not found in `load-path' or jabber-fallback-lib/ directory."))) (defgroup jabber-conn nil "Jabber Connection Settings" :group 'jabber) diff --git a/srv.el b/jabber-fallback-lib/srv.el similarity index 100% rename from srv.el rename to jabber-fallback-lib/srv.el diff --git a/jabber-pkg.el.in b/jabber-pkg.el.in index bcd7f48..43067fa 100644 --- a/jabber-pkg.el.in +++ b/jabber-pkg.el.in @@ -1,5 +1,5 @@ ;; For ELPA: http://tromey.com/elpa/ (define-package "jabber" "@PACKAGE_VERSION@" "A Jabber client for Emacs." - '((fsm "0.2"))) + '((fsm "0.2") (srv "0.2"))) ;; arch-tag: fa652136-12f7-11dd-b4c4-000a95c2fcd0 commit 7fb313c259153dc6af6adebb359e11130f12259f Author: Magnus Henoch <mag...@gm...> Date: Sat Jan 7 00:03:58 2017 +0000 Assume that password-cache.el is available It was introduced in Emacs 23.1, which is our minimum requirement. Remove conditional require of password.el, which used to be part of Gnus. Remove some fboundp calls. diff --git a/jabber-util.el b/jabber-util.el index 40d2b20..c089dcf 100644 --- a/jabber-util.el +++ b/jabber-util.el @@ -22,9 +22,7 @@ ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (require 'cl) -(condition-case nil - (require 'password) - (error nil)) +(require 'password-cache) (condition-case nil (require 'auth-source) (error nil)) @@ -329,24 +327,20 @@ If FULLJIDS is non-nil, complete jids with resources." (funcall secret) secret))) (let ((prompt (format "Jabber password for %s: " bare-jid))) - (if (require 'password-cache nil t) - ;; Need to copy the password, as sasl.el wants to erase it. - (copy-sequence - (password-read prompt (jabber-password-key bare-jid))) - (read-passwd prompt)))))) + ;; Need to copy the password, as sasl.el wants to erase it. + (copy-sequence + (password-read prompt (jabber-password-key bare-jid))))))) (defun jabber-cache-password (bare-jid password) "Cache PASSWORD for BARE-JID." - (when (fboundp 'password-cache-add) - (password-cache-add (jabber-password-key bare-jid) password))) + (password-cache-add (jabber-password-key bare-jid) password)) (defun jabber-uncache-password (bare-jid) "Uncache cached password for BARE-JID. Useful if the password proved to be wrong." (interactive (list (jabber-jid-user (completing-read "Forget password of account: " jabber-account-list nil nil nil 'jabber-account-history)))) - (when (fboundp 'password-cache-remove) - (password-cache-remove (jabber-password-key bare-jid)))) + (password-cache-remove (jabber-password-key bare-jid))) (defun jabber-read-account (&optional always-ask contact-hint) "Ask for which connected account to use. commit 3de7fb40ab9c82ada2a4b5f364a2417345953050 Merge: 98dc8e4 562e503 Author: Magnus Henoch <mag...@er...> Date: Sun Apr 23 13:13:53 2017 +0100 Merge pull request #9 from wasamasa/bugfix-menu-bar Don't display menu bar indicator when installed commit 562e503274a38dfcc1ea3186e0939df9d869cfc3 Author: Vasilij Schneidermann <v.s...@gm...> Date: Thu May 7 11:03:41 2015 +0200 Don't display menu bar indicator when installed See "(elisp) Coding Conventions". Displaying a menu bar indicator if the package was installed violates its first convention, asides from that this check yields a truthy value in nearly all cases for people using this package and therefore makes the other possible branch (is this mode actually in use?) unused. diff --git a/jabber-menu.el b/jabber-menu.el index 40082ee..88c2ab1 100644 --- a/jabber-menu.el +++ b/jabber-menu.el @@ -143,20 +143,10 @@ With prefix argument, remove it." [jabber-menu] (list 'menu-item "Jabber" jabber-menu :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 - (bound-and-true-p jabber-account-list) - (bound-and-true-p jabber-connections))))))) + '(or (eq jabber-display-menu t) + (and (eq jabber-display-menu 'maybe) + (or (bound-and-true-p 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 | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2018-09-27 23:25:10
|
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 c33196772075e6c6ca1dea3ae7bb33094138507a (commit) from 2ef76cff4a5a932cf17dc6107a0c5adee806081e (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 c33196772075e6c6ca1dea3ae7bb33094138507a Author: Magnus Henoch <mag...@gm...> Date: Fri Sep 28 00:20:15 2018 +0100 Use srv.el from package repository srv.el is now a separate package in MELPA, so let's depend on that. Keep a copy in jabber-fallback-lib for the time being. diff --git a/Makefile.am b/Makefile.am index 5eed578..7df29d0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -23,9 +23,10 @@ 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-ourversion.el +jabber-xml.el jabber.el jabber-tmux.el jabber-ourversion.el -compat_lisp_sources = jabber-fallback-lib/hexrgb.el jabber-fallback-lib/fsm.el +compat_lisp_sources = jabber-fallback-lib/hexrgb.el jabber-fallback-lib/fsm.el \ + jabber-fallback-lib/srv.el dist_lisp_LISP=$(my_lisp_sources) $(compat_lisp_sources) jabber-autoloads.el MAINTAINERCLEANFILES=jabber-autoloads.el diff --git a/jabber-conn.el b/jabber-conn.el index 6a4c2d5..ab88a89 100644 --- a/jabber-conn.el +++ b/jabber-conn.el @@ -36,7 +36,16 @@ (ignore-errors (require 'starttls)) -(require 'srv) +(eval-and-compile + (or (ignore-errors (require 'srv)) + (ignore-errors + (let ((load-path (cons (expand-file-name + "jabber-fallback-lib" + (file-name-directory (locate-library "jabber"))) + load-path))) + (require 'srv))) + (error + "srv not found in `load-path' or jabber-fallback-lib/ directory."))) (defgroup jabber-conn nil "Jabber Connection Settings" :group 'jabber) diff --git a/srv.el b/jabber-fallback-lib/srv.el similarity index 100% rename from srv.el rename to jabber-fallback-lib/srv.el diff --git a/jabber-pkg.el.in b/jabber-pkg.el.in index bcd7f48..43067fa 100644 --- a/jabber-pkg.el.in +++ b/jabber-pkg.el.in @@ -1,5 +1,5 @@ ;; For ELPA: http://tromey.com/elpa/ (define-package "jabber" "@PACKAGE_VERSION@" "A Jabber client for Emacs." - '((fsm "0.2"))) + '((fsm "0.2") (srv "0.2"))) ;; arch-tag: fa652136-12f7-11dd-b4c4-000a95c2fcd0 ----------------------------------------------------------------------- Summary of changes: Makefile.am | 5 +++-- jabber-conn.el | 11 ++++++++++- srv.el => jabber-fallback-lib/srv.el | 0 jabber-pkg.el.in | 2 +- 4 files changed, 14 insertions(+), 4 deletions(-) rename srv.el => jabber-fallback-lib/srv.el (100%) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2017-01-07 00:05: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, master has been updated via 2ef76cff4a5a932cf17dc6107a0c5adee806081e (commit) from 98dc8e429ba6f79065f1c9fc3878d92314d4b510 (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 2ef76cff4a5a932cf17dc6107a0c5adee806081e Author: Magnus Henoch <mag...@gm...> Date: Sat Jan 7 00:03:58 2017 +0000 Assume that password-cache.el is available It was introduced in Emacs 23.1, which is our minimum requirement. Remove conditional require of password.el, which used to be part of Gnus. Remove some fboundp calls. diff --git a/jabber-util.el b/jabber-util.el index 40d2b20..c089dcf 100644 --- a/jabber-util.el +++ b/jabber-util.el @@ -22,9 +22,7 @@ ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (require 'cl) -(condition-case nil - (require 'password) - (error nil)) +(require 'password-cache) (condition-case nil (require 'auth-source) (error nil)) @@ -329,24 +327,20 @@ If FULLJIDS is non-nil, complete jids with resources." (funcall secret) secret))) (let ((prompt (format "Jabber password for %s: " bare-jid))) - (if (require 'password-cache nil t) - ;; Need to copy the password, as sasl.el wants to erase it. - (copy-sequence - (password-read prompt (jabber-password-key bare-jid))) - (read-passwd prompt)))))) + ;; Need to copy the password, as sasl.el wants to erase it. + (copy-sequence + (password-read prompt (jabber-password-key bare-jid))))))) (defun jabber-cache-password (bare-jid password) "Cache PASSWORD for BARE-JID." - (when (fboundp 'password-cache-add) - (password-cache-add (jabber-password-key bare-jid) password))) + (password-cache-add (jabber-password-key bare-jid) password)) (defun jabber-uncache-password (bare-jid) "Uncache cached password for BARE-JID. Useful if the password proved to be wrong." (interactive (list (jabber-jid-user (completing-read "Forget password of account: " jabber-account-list nil nil nil 'jabber-account-history)))) - (when (fboundp 'password-cache-remove) - (password-cache-remove (jabber-password-key bare-jid)))) + (password-cache-remove (jabber-password-key bare-jid))) (defun jabber-read-account (&optional always-ask contact-hint) "Ask for which connected account to use. ----------------------------------------------------------------------- Summary of changes: jabber-util.el | 18 ++++++------------ 1 files changed, 6 insertions(+), 12 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2016-01-24 13:54: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 98dc8e429ba6f79065f1c9fc3878d92314d4b510 (commit) from d4d77827418c9b48c80c781a6f6f0d784977bfa6 (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 98dc8e429ba6f79065f1c9fc3878d92314d4b510 Author: Magnus Henoch <mag...@gm...> Date: Sun Jan 24 13:52:22 2016 +0000 Extract jabber-xml-parse-next-stanza, and test it Move the functionality of reading the next complete stanza into a separate function, and add some test cases for it. I'd like to get rid of jabber-xml-skip-tag-forward at some point, so a good first step towards that should be moving calls to it into a function that's easy to test in isolation. diff --git a/jabber-core.el b/jabber-core.el index de05a34..9258647 100644 --- a/jabber-core.el +++ b/jabber-core.el @@ -899,10 +899,7 @@ DATA is any sexp." (while (search-forward-regexp " \\w+=''" nil t) (replace-match ""))) - (setq xml-data (and (catch 'unfinished - (jabber-xml-skip-tag-forward) - (> (point) (point-min))) - (xml-parse-region (point-min) (point)))) + (setq xml-data (jabber-xml-parse-next-stanza)) while xml-data do diff --git a/jabber-xml.el b/jabber-xml.el index e19a247..520f033 100644 --- a/jabber-xml.el +++ b/jabber-xml.el @@ -133,6 +133,17 @@ enough for us." (t (throw 'unfinished nil)))) +(defun jabber-xml-parse-next-stanza () + "Parse the first XML stanza in the current buffer. +Parse and return the first complete XML element in the buffer, +leaving point at the end of it. If there is no complete XML +element, return `nil'." + (and (catch 'unfinished + (goto-char (point-min)) + (jabber-xml-skip-tag-forward) + (> (point) (point-min))) + (xml-parse-region (point-min) (point)))) + (defsubst jabber-xml-node-name (node) "Return the tag associated with NODE. The tag is a lower-case symbol." diff --git a/tests/Makefile.am b/tests/Makefile.am index 8575ddb..e171536 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -2,5 +2,5 @@ # check" or "make distcheck" to work with earlier versions. LOG_COMPILER = env top_builddir=$(top_builddir) $(EMACS) -batch -L $(top_builddir) -L $(top_srcdir) -L $(srcdir) -l TESTS = load-all.el skip-tag-forward.el history.el jabberd.el nick-change-fail.el -TESTS += caps-hash.el +TESTS += caps-hash.el parse-next-stanza.el dist_noinst_DATA = $(TESTS) diff --git a/tests/parse-next-stanza.el b/tests/parse-next-stanza.el new file mode 100644 index 0000000..d4f57b0 --- /dev/null +++ b/tests/parse-next-stanza.el @@ -0,0 +1,18 @@ +;; Tests for jabber-xml-parse-next-stanza + +(require 'jabber-xml) + +(defun parse-it (text) + (with-temp-buffer + (insert text) + (jabber-xml-parse-next-stanza))) + +(unless (equal + (parse-it "<presence from='fo...@ex.../resource' type='unavailable' to='ba...@ex...'/>") + '((presence ((from . "fo...@ex.../resource") (type . "unavailable") (to . "ba...@ex..."))))) + (error "Testcase 1 failed")) + +(unless (equal + (parse-it "<presence from='fo...@ex.../resource' ") + nil) + (error "Testcase 2 failed")) ----------------------------------------------------------------------- Summary of changes: jabber-core.el | 5 +---- jabber-xml.el | 11 +++++++++++ tests/Makefile.am | 2 +- tests/parse-next-stanza.el | 18 ++++++++++++++++++ 4 files changed, 31 insertions(+), 5 deletions(-) create mode 100644 tests/parse-next-stanza.el hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2016-01-24 13:14: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 d4d77827418c9b48c80c781a6f6f0d784977bfa6 (commit) from d5bfa1c62e6474a997e73a836524fdd322c0af44 (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 d4d77827418c9b48c80c781a6f6f0d784977bfa6 Author: David Edmondson <dm...@dm...> Date: Thu Jan 21 09:14:15 2016 +0000 jabber-xml-skip-tag-forward: improve the match regexp Improvements to the scanning of XML tags and properties: - Allow for white space after the parameter assignment sign (=). - Don't allow a closing angle bracket (>) in parameter names. - Skip trailing white space before looking for node termination (> or />). - Match syntax table white space rather than enumerating the white space characters inline. diff --git a/jabber-xml.el b/jabber-xml.el index 46762ed..e19a247 100644 --- a/jabber-xml.el +++ b/jabber-xml.el @@ -111,15 +111,16 @@ enough for us." (if (search-forward "]]>" nil t) (goto-char (match-end 0)) (throw 'unfinished nil))) - ((looking-at "<\\([^ \t\n/>]+\\)\\([ \t\n]+[^=]+='[^']*'\\|[ \t\n]+[^=]+=\"[^\"]*\"\\)*") + ((looking-at "<\\([^[:space:]/>]+\\)\\([[:space:]]+[^=>]+=[[:space:]]*'[^']*'\\|[[:space:]]+[^=>]+=[[:space:]]*\"[^\"]*\"\\)*") (let ((node-name (match-string 1))) (goto-char (match-end 0)) + (skip-syntax-forward "\s-") ; Skip over trailing white space. (cond ((looking-at "/>") (goto-char (match-end 0)) t) ((looking-at ">") - (forward-char 1) + (goto-char (match-end 0)) (unless (and dont-recurse-into-stream (equal node-name "stream:stream")) (loop do (skip-chars-forward "^<") ----------------------------------------------------------------------- Summary of changes: jabber-xml.el | 5 +++-- 1 files changed, 3 insertions(+), 2 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-10-25 23:31:56
|
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 d5bfa1c62e6474a997e73a836524fdd322c0af44 (commit) via 92106a961fc54be33f82d7c09b65b43b79ed3fb9 (commit) from f2aaf7919d2a179e8a541761cad0adbba2f31331 (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 d5bfa1c62e6474a997e73a836524fdd322c0af44 Author: Magnus Henoch <mag...@gm...> Date: Sun Oct 25 23:04:12 2015 +0000 Prefer fsm.el from ELPA fsm.el is now in GNU ELPA, so let's use it if it's installed. Also, let the jabber package depend on it. Keep a copy in jabber-fallback-lib directory, and use it if necessary. Notably, this one is still compatible with Emacs 23. diff --git a/Makefile.am b/Makefile.am index 9b43844..5eed578 100644 --- a/Makefile.am +++ b/Makefile.am @@ -3,7 +3,7 @@ ACLOCAL_AMFLAGS = -I m4 # for options in configure.ac. AUTOMAKE_OPTIONS = 1.11 -my_lisp_sources=fsm.el jabber-activity.el jabber-ahc-presence.el \ +my_lisp_sources=jabber-activity.el jabber-ahc-presence.el \ jabber-ahc.el jabber-alert.el jabber-autoaway.el jabber-avatar.el \ jabber-awesome.el jabber-ping.el jabber-libnotify.el jabber-console.el \ jabber-notifications.el \ @@ -25,7 +25,7 @@ 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-ourversion.el -compat_lisp_sources = jabber-fallback-lib/hexrgb.el +compat_lisp_sources = jabber-fallback-lib/hexrgb.el jabber-fallback-lib/fsm.el dist_lisp_LISP=$(my_lisp_sources) $(compat_lisp_sources) jabber-autoloads.el MAINTAINERCLEANFILES=jabber-autoloads.el diff --git a/jabber-core.el b/jabber-core.el index 0306293..de05a34 100644 --- a/jabber-core.el +++ b/jabber-core.el @@ -27,7 +27,16 @@ (require 'jabber-util) (require 'jabber-logon) (require 'jabber-conn) -(require 'fsm) +(eval-and-compile + (or (ignore-errors (require 'fsm)) + (ignore-errors + (let ((load-path (cons (expand-file-name + "jabber-fallback-lib" + (file-name-directory (locate-library "jabber"))) + load-path))) + (require 'fsm))) + (error + "fsm not found in `load-path' or jabber-fallback-lib/ directory."))) (require 'jabber-sasl) (require 'jabber-console) diff --git a/fsm.el b/jabber-fallback-lib/fsm.el similarity index 100% rename from fsm.el rename to jabber-fallback-lib/fsm.el diff --git a/jabber-pkg.el.in b/jabber-pkg.el.in index f255fc4..bcd7f48 100644 --- a/jabber-pkg.el.in +++ b/jabber-pkg.el.in @@ -1,4 +1,5 @@ ;; For ELPA: http://tromey.com/elpa/ -(define-package "jabber" "@PACKAGE_VERSION@" "A Jabber client for Emacs.") +(define-package "jabber" "@PACKAGE_VERSION@" "A Jabber client for Emacs." + '((fsm "0.2"))) ;; arch-tag: fa652136-12f7-11dd-b4c4-000a95c2fcd0 diff --git a/jabber-socks5.el b/jabber-socks5.el index fa8ac0c..97f6d8a 100644 --- a/jabber-socks5.el +++ b/jabber-socks5.el @@ -24,7 +24,8 @@ (require 'jabber-si-server) (require 'jabber-si-client) -(require 'fsm) +;; jabber-core will require fsm for us +(require 'jabber-core) (eval-when-compile (require 'cl)) (defvar jabber-socks5-pending-sessions nil commit 92106a961fc54be33f82d7c09b65b43b79ed3fb9 Author: Magnus Henoch <mag...@gm...> Date: Sun Oct 25 22:47:02 2015 +0000 FSMs are symbols, not proplists Instead of FSMs being proplists, make them uninterned symbols, storing their properties in the proplist slot. This makes debugging much more pleasant, as backtraces no longer display the entire state data multiple times. diff --git a/fsm.el b/fsm.el index 4bc4ebf..e97dc09 100644 --- a/fsm.el +++ b/fsm.el @@ -167,14 +167,16 @@ arguments. ,docstring ,@interactive-spec (fsm-debug-output "Starting %s" ',name) - (let ((fsm (list :fsm ',name))) + (let ((fsm (gensym (concat "fsm-" ,(symbol-name name) "-")))) (destructuring-bind (state state-data &optional timeout) (progn ,@body) - (nconc fsm (list :state nil :state-data nil - :sleep ,(or sleep (lambda (secs) - (accept-process-output - nil secs))) - :deferred nil)) + (put fsm :name ',name) + (put fsm :state nil) + (put fsm :state-data nil) + (put fsm :sleep ,(or sleep (lambda (secs) + (accept-process-output + nil secs)))) + (put fsm :deferred nil) (fsm-update fsm state state-data timeout) fsm))))))) @@ -286,20 +288,17 @@ any state machines using them. Return nil." The timer is canceled if another event occurs before, unless the event handler explicitly asks to keep the timer." (fsm-stop-timer fsm) - (setf (cddr fsm) - (plist-put - (cddr fsm) - :timeout (run-with-timer secs - nil - #'fsm-send-sync fsm - :timeout)))) + (put fsm + :timeout (run-with-timer + secs nil + #'fsm-send-sync fsm :timeout))) (defun fsm-stop-timer (fsm) "Stop the timeout timer of FSM." - (let ((timer (plist-get (cddr fsm) :timeout))) + (let ((timer (get fsm :timeout))) (when (timerp timer) (cancel-timer timer) - (setf (cddr fsm) (plist-put (cddr fsm) :timeout nil))))) + (put fsm :timeout nil)))) (defun fsm-maybe-change-timer (fsm timeout) "Change the timer of FSM according to TIMEOUT." @@ -318,10 +317,10 @@ CALLBACK with the response as only argument." (run-with-timer 0 nil #'fsm-send-sync fsm event callback)) (defun fsm-update (fsm new-state new-state-data timeout) - (let ((fsm-name (cadr fsm)) - (old-state (plist-get (cddr fsm) :state))) - (plist-put (cddr fsm) :state new-state) - (plist-put (cddr fsm) :state-data new-state-data) + (let ((fsm-name (get fsm :name)) + (old-state (get fsm :state))) + (put fsm :state new-state) + (put fsm :state-data new-state-data) (fsm-maybe-change-timer fsm timeout) ;; On state change, call enter function and send deferred events @@ -335,14 +334,13 @@ CALLBACK with the response as only argument." (destructuring-bind (newer-state-data newer-timeout) (funcall enter-fn fsm new-state-data) (fsm-debug-output "Using data from enter function") - (plist-put (cddr fsm) :state-data newer-state-data) + (put fsm :state-data newer-state-data) (fsm-maybe-change-timer fsm newer-timeout)) ((debug error) (fsm-debug-output "Didn't work: %S" e))))) - (let ((deferred (nreverse (plist-get (cddr fsm) :deferred)))) - (setf (cddr fsm) - (plist-put (cddr fsm) :deferred nil)) + (let ((deferred (nreverse (get fsm :deferred)))) + (put fsm :deferred nil) (dolist (event deferred) (apply 'fsm-send-sync fsm event)))))) @@ -351,9 +349,9 @@ CALLBACK with the response as only argument." If the state machine generates a response, eventually call CALLBACK with the response as only argument." (save-match-data - (let* ((fsm-name (second fsm)) - (state (plist-get (cddr fsm) :state)) - (state-data (plist-get (cddr fsm) :state-data)) + (let* ((fsm-name (get fsm :name)) + (state (get fsm :state)) + (state-data (get fsm :state-data)) (state-fn (gethash state (get fsm-name :fsm-event)))) ;; If the event is a list, output only the car, to avoid an ;; overflowing debug buffer. @@ -366,9 +364,8 @@ CALLBACK with the response as only argument." ;; Special case for deferring an event until next state change. (cond ((eq result :defer) - (let ((deferred (plist-get (cddr fsm) :deferred))) - (plist-put (cddr fsm) :deferred - (cons (list event callback) deferred)))) + (let ((deferred (get fsm :deferred))) + (put fsm :deferred (cons (list event callback) deferred)))) ((null result) (fsm-debug-output "Warning: event %S ignored in state %s/%s" event fsm-name state)) ((eq (car-safe result) :error-signaled) @@ -411,13 +408,13 @@ Events sent are of the form (:sentinel PROCESS STRING)." (defun fsm-sleep (fsm secs) "Sleep up to SECS seconds in a way that lets FSM receive events." - (funcall (plist-get (cddr fsm) :sleep) secs)) + (funcall (get fsm :sleep) secs)) (defun fsm-get-state-data (fsm) "Return the state data of FSM. Note the absence of a set function. The fsm should manage its state data itself; other code should just send messages to it." - (plist-get (cddr fsm) :state-data)) + (get fsm :state-data)) (provide 'fsm) ----------------------------------------------------------------------- Summary of changes: Makefile.am | 4 +- jabber-core.el | 11 ++++++- fsm.el => jabber-fallback-lib/fsm.el | 59 ++++++++++++++++------------------ jabber-pkg.el.in | 3 +- jabber-socks5.el | 3 +- 5 files changed, 44 insertions(+), 36 deletions(-) rename fsm.el => jabber-fallback-lib/fsm.el (92%) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-10-25 22:46: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 f2aaf7919d2a179e8a541761cad0adbba2f31331 (commit) from 20663ad928f0690ff0030c1a0d991b35d1d059ce (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 f2aaf7919d2a179e8a541761cad0adbba2f31331 Author: Magnus Henoch <mag...@gm...> Date: Sun Oct 25 22:32:34 2015 +0000 Check entered JID in jabber-connect Without this check, we would connect as "nil@nil" when given empty input for the JID. diff --git a/jabber-core.el b/jabber-core.el index 1a44e8a..0306293 100644 --- a/jabber-core.el +++ b/jabber-core.el @@ -192,6 +192,10 @@ With double prefix argument, specify more connection details." (entry (assoc jid jabber-account-list)) (alist (cdr entry)) password network-server port connection-type registerp) + (when (zerop (length jid)) + (error "No JID specified")) + (unless (jabber-jid-username jid) + (error "Missing username part in JID")) (when entry ;; If the user entered the JID of one of the preconfigured ;; accounts, use that data. ----------------------------------------------------------------------- Summary of changes: jabber-core.el | 4 ++++ 1 files changed, 4 insertions(+), 0 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-10-24 13:24:58
|
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 20663ad928f0690ff0030c1a0d991b35d1d059ce (commit) from a1835deb5c8e1609b2ba0aa1c65a2cfa88c76aca (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 20663ad928f0690ff0030c1a0d991b35d1d059ce Author: Magnus Henoch <mag...@gm...> Date: Sat Oct 24 14:23:09 2015 +0100 jabber-read-account: find live connection if possible If the current buffer is associated with a dead connection, and there is a live connection for the same bare JID, suggest that as the default when prompting for which account to use. diff --git a/jabber-util.el b/jabber-util.el index 8e4438e..40d2b20 100644 --- a/jabber-util.el +++ b/jabber-util.el @@ -387,7 +387,7 @@ that has that contact in its roster." (jabber-connection-bare-jid matching)))) ;; if the buffer is associated with a connection, use it (when (and jabber-buffer-connection - (memq jabber-buffer-connection jabber-connections)) + (jabber-find-active-connection jabber-buffer-connection)) (jabber-connection-bare-jid jabber-buffer-connection)) ;; else, use the first connection in the list (caar completions))) ----------------------------------------------------------------------- Summary of changes: jabber-util.el | 2 +- 1 files changed, 1 insertions(+), 1 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-10-23 16:03:32
|
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 a1835deb5c8e1609b2ba0aa1c65a2cfa88c76aca (commit) from 1f858cc4f3cdabcd7380a7d08af273bcdd708c15 (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 a1835deb5c8e1609b2ba0aa1c65a2cfa88c76aca Author: Magnus Henoch <mag...@gm...> Date: Mon Jul 13 09:09:33 2015 +0100 Clearer docstring for jabber-account-list diff --git a/jabber.el b/jabber.el index 55eec68..607b726 100644 --- a/jabber.el +++ b/jabber.el @@ -39,13 +39,18 @@ where the car is a JID and the CDR is an alist. JID is a full Jabber ID string (e.g. fo...@ba...d). You can also specify the resource (e.g. fo...@ba...d/emacs). The following keys can be present in the alist: -:password is a string to authenticate ourself against the server. -It can be empty. -:network-server is a string identifying the address to connect to, -if it's different from the server part of the JID. -:port is the port to use (default depends on connection type). -:connection-type is a symbol. Valid symbols are `starttls', -`network' and `ssl'. + + :password is a string to authenticate ourself against the server. + It can be empty. If you don't want to store your password in your + Emacs configuration, try auth-source (info node `(auth)Top'). + + :network-server is a string identifying the address to connect to, + if it's different from the server part of the JID. + + :port is the port to use (default depends on connection type). + + :connection-type is a symbol. Valid symbols are `starttls', + `network' and `ssl'. Only JID is mandatory. The rest can be guessed at run-time. ----------------------------------------------------------------------- Summary of changes: jabber.el | 19 ++++++++++++------- 1 files changed, 12 insertions(+), 7 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-06-27 18:05:47
|
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 1f858cc4f3cdabcd7380a7d08af273bcdd708c15 (commit) via 23c46a69e16ca4c432cbcedc6961162bf382cfa3 (commit) via 4616a9ea918343112c9701a0b768be510fa7db0e (commit) via 2c6156a92c9ae2438a3f97aef9daaeb12ce5776f (commit) from d9bbe9ba024557b1f9afd274a93964f192ebe871 (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 1f858cc4f3cdabcd7380a7d08af273bcdd708c15 Author: Magnus Henoch <mag...@gm...> Date: Sat Jun 27 18:06:23 2015 +0100 Don't signal error for chat states on dead connection If there is a chat buffer with chat state notifications enabled, and the connection being used has been lost, and the user has reconnected, and started typing a message in the chat buffer, then we would try to send the "typing" notification to the old dead connection, causing an error. Avoid that by ignoring errors when sending notifications. diff --git a/jabber-chatstates.el b/jabber-chatstates.el index 9cd561e..83090f8 100644 --- a/jabber-chatstates.el +++ b/jabber-chatstates.el @@ -103,7 +103,7 @@ It can be sent and cancelled several times.") "Send an 'paused state notification." (when (and jabber-chatstates-requested jabber-chatting-with) (setq jabber-chatstates-composing-sent nil) - (jabber-send-sexp + (jabber-send-sexp-if-connected jabber-buffer-connection `(message ((to . ,jabber-chatting-with) @@ -117,7 +117,7 @@ It can be sent and cancelled several times.") jabber-chatting-with jabber-chatstates-requested (not (eq composing-now jabber-chatstates-composing-sent))) - (jabber-send-sexp + (jabber-send-sexp-if-connected jabber-buffer-connection `(message ((to . ,jabber-chatting-with) commit 23c46a69e16ca4c432cbcedc6961162bf382cfa3 Author: Magnus Henoch <mag...@gm...> Date: Sat Jun 27 18:05:45 2015 +0100 Comment about srv--nslookup being Windows-specific diff --git a/srv.el b/srv.el index d5455bb..2309f18 100644 --- a/srv.el +++ b/srv.el @@ -106,6 +106,9 @@ of the list. The list is empty if no SRV records were found." (call-process "nslookup" nil t nil "-type=srv" target) (goto-char (point-min)) (let (results) + ;; This matches what nslookup prints on Windows. It's unlikely + ;; to work for other systems, but on those systems we use DNS + ;; directly. (while (search-forward-regexp (concat "[\s\t]*priority += \\(.*\\)\r?\n" "[\s\t]*weight += \\(.*\\)\r?\n" commit 4616a9ea918343112c9701a0b768be510fa7db0e Author: Magnus Henoch <mag...@gm...> Date: Sat Jun 27 18:04:31 2015 +0100 jabber-encode-time should use its argument Incidentally this hasn't mattered much, since most of the time we use it to encode the current time anyway. diff --git a/jabber-util.el b/jabber-util.el index b6e1304..8e4438e 100644 --- a/jabber-util.el +++ b/jabber-util.el @@ -467,7 +467,7 @@ Return nil if no such data available." (defun jabber-encode-time (time) "Convert TIME to a string by JEP-0082. TIME is in a format accepted by `format-time-string'." - (format-time-string "%Y-%m-%dT%H:%M:%SZ" nil t)) + (format-time-string "%Y-%m-%dT%H:%M:%SZ" time t)) (defun jabber-encode-timezone () (let ((time-zone-offset (nth 0 (current-time-zone)))) commit 2c6156a92c9ae2438a3f97aef9daaeb12ce5776f Author: Magnus Henoch <mag...@gm...> Date: Sat Jun 27 18:03:26 2015 +0100 Fix time stamp retrieval in jabber-maybe-print-rare-time diff --git a/jabber-chat.el b/jabber-chat.el index e6486f1..6feaad5 100644 --- a/jabber-chat.el +++ b/jabber-chat.el @@ -455,8 +455,8 @@ This function is used as an ewoc prettyprinter." (prev-data (when prev (ewoc-data prev)))) (flet ((entry-time (entry) (or (when (listp (cadr entry)) - (jabber-message-timestamp (cadr entry)) - (plist-get (cddr entry) :time))))) + (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) ----------------------------------------------------------------------- Summary of changes: jabber-chat.el | 4 ++-- jabber-chatstates.el | 4 ++-- jabber-util.el | 2 +- srv.el | 3 +++ 4 files changed, 8 insertions(+), 5 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-04-28 18:50:27
|
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, roster-optimisation has been updated via a7c0003c8045e92eb2960f88d5f6b947ae3def7c (commit) from 356d8924a0f51daaa2740f36b751db250355eb7d (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 a7c0003c8045e92eb2960f88d5f6b947ae3def7c Author: Magnus Henoch <mag...@gm...> Date: Tue Apr 28 19:48:36 2015 +0100 Fix group membership detection when deciding how to redisplay roster Consistently use group names as keys in group ewoc node hash table. Remove entries from hash table when ewoc nodes are deleted. Undo earlier "optimisation", which was incorrect but appeared to be correct because the roster would always be redrawn completely. diff --git a/jabber-roster.el b/jabber-roster.el index ff88571..be9da5d 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -595,7 +595,7 @@ H Toggle displaying this text (when (or jabber-roster-show-empty-group (> (length buddies) 0)) (let ((group-node (ewoc-enter-last ewoc (list group nil)))) - (puthash group group-node group-ewoc-node-hash) + (puthash group-name group-node group-ewoc-node-hash) (if (not (find group-name (plist-get (fsm-get-state-data jc) :roster-roll-groups) @@ -774,13 +774,11 @@ three being lists of JID symbols." (old-groups (mapcar #'caar existing-ewoc-data)) (new-groups (or (get insert-this 'groups) (list jabber-roster-default-group-name)))) - ;; If a contact is added to a group that's currently not - ;; displayed, we currently need to redraw the entire roster - ;; buffer. + ;; If a contact is added to a group, we currently need to + ;; redraw the entire roster buffer. (setq need-redraw (or need-redraw - (some (lambda (group) (null (gethash group group-ewoc-node-hash))) - new-groups))) + (not (null (set-difference new-groups old-groups :test #'string=))))) (when jabber-roster-debug (message (concat "insert jid: " jid))) (dolist (group new-groups) @@ -845,6 +843,7 @@ three being lists of JID symbols." (or (null next) (null (cadr (ewoc-data next))))) ;; That means that we just emptied a group. Let's ;; remove the preceding group heading. + (remhash (caar (ewoc-data previous)) group-ewoc-node-hash) (ewoc-delete ewoc previous)))))) ;; changed-items and deleted-items are lists of symbols. Let's ;; look them up in buddy-ewoc-node-hash. ----------------------------------------------------------------------- Summary of changes: jabber-roster.el | 11 +++++------ 1 files changed, 5 insertions(+), 6 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-04-22 11:27:47
|
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, roster-optimisation has been updated via 356d8924a0f51daaa2740f36b751db250355eb7d (commit) from 74202d4c8d3bf2770a30a7fad54ff975fa28e49c (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 356d8924a0f51daaa2740f36b751db250355eb7d Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 22 11:18:58 2015 +0100 Only do a complete redraw if a new roster group is added diff --git a/jabber-roster.el b/jabber-roster.el index ad70017..ff88571 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -774,11 +774,13 @@ three being lists of JID symbols." (old-groups (mapcar #'caar existing-ewoc-data)) (new-groups (or (get insert-this 'groups) (list jabber-roster-default-group-name)))) - ;; If a contact is added to a group, we currently need to - ;; redraw the entire roster buffer. + ;; If a contact is added to a group that's currently not + ;; displayed, we currently need to redraw the entire roster + ;; buffer. (setq need-redraw (or need-redraw - (not (null (set-difference new-groups old-groups :test #'string=))))) + (some (lambda (group) (null (gethash group group-ewoc-node-hash))) + new-groups))) (when jabber-roster-debug (message (concat "insert jid: " jid))) (dolist (group new-groups) ----------------------------------------------------------------------- Summary of changes: jabber-roster.el | 8 +++++--- 1 files changed, 5 insertions(+), 3 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-04-21 10:19:29
|
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, roster-optimisation has been updated via 74202d4c8d3bf2770a30a7fad54ff975fa28e49c (commit) via 3d9348c255740be2e44c9206827faf58b4eda083 (commit) from 5e5f6de6e2c8b4bd4de7d9b3a910b31b3fa6a25d (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 74202d4c8d3bf2770a30a7fad54ff975fa28e49c Author: Magnus Henoch <mag...@gm...> Date: Mon Apr 20 20:16:27 2015 +0100 No need to special-case items being added to the roster Currently they'll trigger a complete roster redraw by virtue of adding a contact to a certain roster group. diff --git a/jabber-roster.el b/jabber-roster.el index 3a5205a..ad70017 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -740,8 +740,7 @@ three being lists of JID symbols." (all-groups (plist-get (fsm-get-state-data jc) :roster-groups)) (buddy-ewoc-node-hash (plist-get (fsm-get-state-data jc) :buddy-ewoc-node-hash)) (group-ewoc-node-hash (plist-get (fsm-get-state-data jc) :group-ewoc-node-hash)) - ;; Currently we need to redraw the roster when items are added. - (need-redraw (not (null new-items)))) + (need-redraw nil)) ;; fix a old-roster (dolist (delete-this deleted-items) commit 3d9348c255740be2e44c9206827faf58b4eda083 Author: Magnus Henoch <mag...@gm...> Date: Fri Apr 17 20:53:41 2015 +0100 Delete roster items in QuickCheck test This didn't reveal any errors. diff --git a/tests/roster-display.hs b/tests/roster-display.hs index 2be41bd..9505d75 100644 --- a/tests/roster-display.hs +++ b/tests/roster-display.hs @@ -9,6 +9,7 @@ import Data.Char (toLower) import Control.Monad (liftM, mfilter) data RosterEvent = IqRoster JID [Group] (Maybe String) | + IqRosterDelete JID | Presence JID PresenceType | Noop deriving (Show, Eq) @@ -18,6 +19,7 @@ instance Arbitrary RosterEvent where [ do groups <- arbitrary maybeName <- arbitraryName return $ IqRoster jid (nub groups) maybeName, + return $ IqRosterDelete jid, do presenceType <- arbitrary return $ Presence jid presenceType] where arbitraryName :: Gen (Maybe String) @@ -79,6 +81,10 @@ toLisp (IqRoster (JID jid) groups maybeName) = ") "++ concat ["(group () \""++group++"\")" | (Group group) <- groups] ++ " )))" +toLisp (IqRosterDelete (JID jid)) = + "(iq ((type . \"set\"))"++ + " (query ((xmlns . \"jabber:iq:roster\"))" ++ + " (item ((jid . \""++jid++"\") (subscription . \"remove\")))))" toLisp (Presence (JID jid) Unavailable) = "(presence ((from . \""++jid++"\") (type . \"unavailable\")))" toLisp (Presence (JID jid) Online) = ----------------------------------------------------------------------- Summary of changes: jabber-roster.el | 3 +-- tests/roster-display.hs | 6 ++++++ 2 files changed, 7 insertions(+), 2 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-04-17 10:12:40
|
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, roster-optimisation has been updated via 5e5f6de6e2c8b4bd4de7d9b3a910b31b3fa6a25d (commit) from 3d32b14025e9eebd69f8dcdb2288d1a2e1431dba (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 5e5f6de6e2c8b4bd4de7d9b3a910b31b3fa6a25d Author: Magnus Henoch <mag...@gm...> Date: Fri Apr 17 10:49:35 2015 +0100 Add QuickCheck test The test will be skipped unless the driver program has been explicitly compiled before. diff --git a/tests/.gitignore b/tests/.gitignore index e2f3fd3..22e9adb 100644 --- a/tests/.gitignore +++ b/tests/.gitignore @@ -1,2 +1,5 @@ *.log -*.trs \ No newline at end of file +*.trs +roster-display +roster-display.hi +roster-display.o diff --git a/tests/Makefile.am b/tests/Makefile.am index 216b4ff..8e8a9c3 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -2,5 +2,8 @@ # check" or "make distcheck" to work with earlier versions. LOG_COMPILER = env top_builddir=$(top_builddir) $(EMACS) -batch -L $(top_builddir) -L $(top_srcdir) -L $(srcdir) -l TESTS = load-all.el skip-tag-forward.el history.el jabberd.el nick-change-fail.el -TESTS += caps-hash.el roster-display.el +TESTS += caps-hash.el roster-display.el roster-display-qc.el dist_noinst_DATA = $(TESTS) + +roster-display: roster-display.hs + ghc $< diff --git a/tests/roster-display-qc.el b/tests/roster-display-qc.el new file mode 100644 index 0000000..ffc319f --- /dev/null +++ b/tests/roster-display-qc.el @@ -0,0 +1,107 @@ +(require 'jabberd) +(require 'cl) + +(setq jabber-roster-show-bindings nil) + +(jabberd-connect) + +(with-timeout (5 (progn + (princ (with-current-buffer "*fsm-debug*" (buffer-string))) + (error "Timeout"))) + (while (not (equal "" *jabber-current-show*)) + (sit-for 0.1))) + +(princ (format "in %s now\n" default-directory)) + +(defun rd-clear-roster () + (let ((state-data (fsm-get-state-data (car jabber-connections)))) + ;; First unintern everything: + (jabber-clear-roster) + (plist-put state-data :roster nil) + (plist-put state-data :roster-hash nil))) + +(let* ((program (expand-file-name "roster-display" (file-name-directory load-file-name))) + (p (if (not (file-executable-p program)) + (progn + (princ + (format "%s not found or not executable; skipping Quickcheck test\n" + program)) + ;; Exit code 77 means "skip" to automake + (kill-emacs 77)) + (start-process "roster-display" "*roster-display*" program))) + done) + (with-current-buffer (process-buffer p) + (while (not done) + (while (progn (goto-char (point-min)) (not (search-forward-regexp "^[a-z]" nil t))) + (accept-process-output p)) + (goto-char (match-beginning 0)) + (cond + ((looking-at "success") + (setq done t) + (princ "Success!\n")) + ((looking-at "failure") + (while (process-live-p p) + (accept-process-output p)) + (princ (buffer-substring (point) (point-max))) + (error "it failed")) + ((looking-at "check") + (let ((all-messages-s (delete-and-extract-region (point-min) (point))) + all-messages + roster-1 roster-2) + (delete-region (point-min) (point-max)) + (with-temp-buffer + (insert all-messages-s) + (goto-char (point-min)) + (while + (condition-case e + (push (read (current-buffer)) all-messages) + (end-of-file + nil)))) + (setq all-messages (nreverse all-messages)) + (dolist (m all-messages) + (jabber-process-input (car jabber-connections) m)) + + ;; The presence stanza causes an asynchronous :roster-update message + ;; to be sent. Let's wait for that. + (accept-process-output nil 0.1) + + ;; Roster updates are batched. Force a timeout. + (fsm-send-sync (car jabber-connections) :timeout) + + (with-current-buffer jabber-roster-buffer + (setq roster-1 (buffer-substring-no-properties (point-min) (point-max)))) + + (jabber-display-roster) + + (with-current-buffer jabber-roster-buffer + (setq roster-2 (buffer-substring-no-properties (point-min) (point-max)))) + + (if (equal roster-1 roster-2) + (process-send-string p "t\n") + (let ((result (mismatch roster-1 roster-2))) + (if (null result) + (princ "match\n") + (princ "mismatch! Expected:\n") + (prin1 roster-2) + (princ "\nBut got:\n") + (prin1 (substring roster-1 0 result)) + (princ " ***mismatch here*** ") + (prin1 (substring roster-1 result)) + (princ "\n"))) + (process-send-string p "nil\n")) + (rd-clear-roster) + + (jabber-disconnect) + (jabberd-connect) + + (setq *jabber-current-show* nil) + (with-timeout (5 (progn + (princ (with-current-buffer "*fsm-debug*" (buffer-string))) + (error "Timeout"))) + (while (not (equal "" *jabber-current-show*)) + (sit-for 0.1))) + + (jabber-display-roster))) + (t + (princ (concat "What's that?\n'" (buffer-substring (point) (point-max)))) + (error "???")))))) diff --git a/tests/roster-display.hs b/tests/roster-display.hs new file mode 100644 index 0000000..2be41bd --- /dev/null +++ b/tests/roster-display.hs @@ -0,0 +1,89 @@ +import Test.QuickCheck (Arbitrary, arbitrary, shrink, Property, quickCheck, (==>), choose, + oneof, quickCheckWithResult, stdArgs, Args(..), Result(..)) +import Test.QuickCheck.Arbitrary (shrinkList, shrinkNothing) +import Test.QuickCheck.Monadic (assert, monadicIO, pick, pre, run) +import Test.QuickCheck.Property (printTestCase) +import Test.QuickCheck.Gen (Gen) +import Data.List (nub) +import Data.Char (toLower) +import Control.Monad (liftM, mfilter) + +data RosterEvent = IqRoster JID [Group] (Maybe String) | + Presence JID PresenceType | + Noop + deriving (Show, Eq) +instance Arbitrary RosterEvent where + arbitrary = do jid <- arbitrary + oneof + [ do groups <- arbitrary + maybeName <- arbitraryName + return $ IqRoster jid (nub groups) maybeName, + do presenceType <- arbitrary + return $ Presence jid presenceType] + where arbitraryName :: Gen (Maybe String) + arbitraryName = oneof [return Nothing, + liftM Just arbitrarySensibleString] + shrink Noop = [] + shrink (IqRoster (JID j) groups name) = + [Noop] ++ + [IqRoster (JID j) newGroups newName | + newGroups <- (shrinkList shrink groups), + newName <- shrink name] + shrink _ = [Noop] + +arbitrarySensibleString = + do arbitraryString <- arbitrary + return $ filter (\c -> c >= ' ' && c <= '~') arbitraryString + +data JID = JID String deriving (Eq) +instance Arbitrary JID where + arbitrary = do + x <- choose ('a', 'e') + return . JID $ [x] ++ "@example.com" +instance Show JID where + show (JID s) = s + +data Group = Group String deriving (Eq) +instance Arbitrary Group where + arbitrary = do + x <- choose ('a', 'e') + return . Group $ [x] + shrink (Group (x:[])) = [Group [y] | y <- ['a' .. (pred x)]] +instance Show Group where + show (Group s) = s + +data PresenceType = Unavailable | Online | Chat | Away | XA | DND deriving (Show, Eq) +instance Arbitrary PresenceType where + arbitrary = oneof $ map return [Unavailable, Online, Chat, Away, XA, DND] + +main = do result <- quickCheckWithResult (stdArgs { chatty = False }) prop_rosterEvents + case result of + Success {} -> putStrLn "success" + Failure { output = o } -> putStrLn $ "failure: " ++ o + +prop_rosterEvents :: [RosterEvent] -> Property +prop_rosterEvents events = + printTestCase ("counterexample: " ++ unlines asLisp) $ monadicIO test + where test = do result <- run testIO + assert (result == "t") + testIO = do mapM putStrLn asLisp + putStrLn "check" + getLine + asLisp = map toLisp events + +toLisp (IqRoster (JID jid) groups maybeName) = + "(iq ((type . \"set\"))"++ + " (query ((xmlns . \"jabber:iq:roster\"))" ++ + " (item ((jid . \""++jid++"\")" ++ + maybe "" (\name -> " (name . " ++ show name ++ ")") maybeName ++ + ") "++ + concat ["(group () \""++group++"\")" | (Group group) <- groups] ++ + " )))" +toLisp (Presence (JID jid) Unavailable) = + "(presence ((from . \""++jid++"\") (type . \"unavailable\")))" +toLisp (Presence (JID jid) Online) = + "(presence ((from . \""++jid++"\")))" +toLisp (Presence (JID jid) presenceType) = + "(presence ((from . \""++jid++"\")) "++ + " (show () \""++(map toLower (show presenceType))++"\"))" +toLisp Noop = "" ----------------------------------------------------------------------- Summary of changes: tests/.gitignore | 5 ++- tests/Makefile.am | 5 ++- tests/roster-display-qc.el | 107 ++++++++++++++++++++++++++++++++++++++++++++ tests/roster-display.hs | 89 ++++++++++++++++++++++++++++++++++++ 4 files changed, 204 insertions(+), 2 deletions(-) create mode 100644 tests/roster-display-qc.el create mode 100644 tests/roster-display.hs hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-04-16 10:48:35
|
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, roster-optimisation has been updated via 3d32b14025e9eebd69f8dcdb2288d1a2e1431dba (commit) via 8e3e41e386283d8269fe6615dfce1db60c332d1e (commit) from 9bf8d47f8caa8c346beb45501293650347836794 (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 3d32b14025e9eebd69f8dcdb2288d1a2e1431dba Author: Magnus Henoch <mag...@gm...> Date: Thu Apr 16 11:28:14 2015 +0100 Display names of loaded files in load-all test This makes it easier to find which file causes an error when loaded. diff --git a/tests/load-all.el b/tests/load-all.el index 77006d9..6e29abd 100644 --- a/tests/load-all.el +++ b/tests/load-all.el @@ -3,6 +3,7 @@ (let* ((default-directory (expand-file-name (getenv "top_builddir"))) (elc-files (file-expand-wildcards "*.elc" t))) (dolist (f elc-files) + (princ (format "Loading %s...\n" f)) (load f nil t))) ;; arch-tag: 509c4808-2e92-11dd-9c8c-000a95c2fcd0 commit 8e3e41e386283d8269fe6615dfce1db60c332d1e Author: Magnus Henoch <mag...@gm...> Date: Thu Apr 16 11:03:48 2015 +0100 Fix roster item sorting when several items change When several roster items change at once, the sort order would sometimes become messed up. Avoid that by treating items being changed specially while sorting. Also add several test cases. diff --git a/jabber-roster.el b/jabber-roster.el index 9c16241..3a5205a 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -856,51 +856,64 @@ three being lists of JID symbols." (remhash buddy buddy-ewoc-node-hash))) ;; Hm, what is the ewoc data exactly? It's a list, (GROUP BUDDY). ;; BUDDY is a symbol, so it already contains all relevant data. - (dolist (buddy changed-items) - (let* ((inhibit-read-only t) - (entry (gethash buddy buddy-ewoc-node-hash)) - (current-groups (or (get buddy 'groups) - (list jabber-roster-default-group-name))) - new-entry) - (dolist (node entry) - (if (not (member (caar (ewoc-data node)) current-groups)) - ;; If the contact has been removed from a roster group, - ;; just remove from display under that roster group. - (funcall delete-roster-item node) - ;; Check if the sort order has changed. - (cond - ;; Should the item move up? - ((let ((previous (ewoc-prev ewoc node)) - insert-before) - (while (let ((previous-buddy (and previous (cadr (ewoc-data previous))))) - (when (and previous-buddy - (jabber-roster-sort-items buddy previous-buddy)) - (setq insert-before previous) - (setq previous (ewoc-prev ewoc previous)) - t))) - (when insert-before - (let ((data (ewoc-data node))) - (ewoc-delete ewoc node) - (push (ewoc-enter-before ewoc insert-before data) new-entry))))) - ;; Should the item move down? - ((let ((next (ewoc-next ewoc node)) - insert-after) - (while (let ((next-buddy (and next (cadr (ewoc-data next))))) - (when (and next-buddy - (jabber-roster-sort-items next-buddy buddy)) - (setq insert-after next) - (setq next (ewoc-next ewoc next)) - t))) - (when insert-after - (let ((data (ewoc-data node))) - (ewoc-delete ewoc node) - (push (ewoc-enter-after ewoc insert-after data) new-entry))))) - ;; Or should it be updated in place? - (t - (ewoc-invalidate ewoc node) - (push node new-entry))))) - ;; Update hash table with new ewoc node list. - (puthash buddy new-entry buddy-ewoc-node-hash))))))) + (setq changed-items (sort changed-items #'jabber-roster-sort-items)) + (let (buddy) + (while (setq buddy (pop changed-items)) + (let* ((inhibit-read-only t) + (entry (gethash buddy buddy-ewoc-node-hash)) + (current-groups (or (get buddy 'groups) + (list jabber-roster-default-group-name))) + new-entry) + (dolist (node entry) + (if (not (member (caar (ewoc-data node)) current-groups)) + ;; If the contact has been removed from a roster group, + ;; just remove from display under that roster group. + (funcall delete-roster-item node) + ;; Check if the sort order has changed. + (cond + ;; Should the item move up? + ((let ((previous (ewoc-prev ewoc node)) + insert-before) + (while (let ((previous-buddy (and previous (cadr (ewoc-data previous))))) + (when (and previous-buddy + ;; If we're reordering several items at a time, + ;; the comparison won't be accurate, since + ;; the ewoc position represents the previous + ;; state, but the symbol plist represents the + ;; current state. Let's always sort upwards + ;; for now. + (if (memq previous-buddy changed-items) + t + (jabber-roster-sort-items buddy previous-buddy))) + (setq insert-before previous) + (setq previous (ewoc-prev ewoc previous)) + t))) + (when insert-before + (let ((data (ewoc-data node))) + (ewoc-delete ewoc node) + (push (ewoc-enter-before ewoc insert-before data) new-entry))))) + ;; Should the item move down? + ((let ((next (ewoc-next ewoc node)) + insert-after) + (while (let ((next-buddy (and next (cadr (ewoc-data next))))) + (when (and next-buddy + ;; Ditto but vice versa. + (if (memq next-buddy changed-items) + nil + (jabber-roster-sort-items next-buddy buddy))) + (setq insert-after next) + (setq next (ewoc-next ewoc next)) + t))) + (when insert-after + (let ((data (ewoc-data node))) + (ewoc-delete ewoc node) + (push (ewoc-enter-after ewoc insert-after data) new-entry))))) + ;; Or should it be updated in place? + (t + (ewoc-invalidate ewoc node) + (push node new-entry))))) + ;; Update hash table with new ewoc node list. + (puthash buddy new-entry buddy-ewoc-node-hash)))))))) (defalias 'jabber-presence-update-roster 'ignore) ;;jabber-presence-update-roster is not needed anymore. diff --git a/tests/roster-display.el b/tests/roster-display.el index c16f7c8..8eb9efe 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -25,6 +25,13 @@ (defvar rd-roster-string nil) +(defun rd-clear-roster () + (let ((state-data (fsm-get-state-data (car jabber-connections)))) + ;; First unintern everything: + (jabber-clear-roster) + (plist-put state-data :roster nil) + (plist-put state-data :roster-hash nil))) + (defun rd-check-roster-buffer (&optional _jc) ;; The presence stanza causes an asynchronous :roster-update message ;; to be sent. Let's wait for that. @@ -462,3 +469,117 @@ " * ju...@ca... Online \n" "__________________________________\n" "\n")) + +(rd-clear-roster) + +;; This test case was found through a Quickcheck property. +(dolist (input '((iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "c...@ex...")) (group () "d") ))) + (iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "d...@ex...")) (group () "d") ))) + (iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "e...@ex...")) (group () "d") ))) + (presence ((from . "e...@ex...")) + (show () "dnd")) + (presence ((from . "d...@ex..."))))) + (jabber-process-input (car jabber-connections) input)) + +(rd-check-roster-buffer) + +(rd-compare + "Something wrong with ordering" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "d\n" + " * d...@ex... Online \n" + " * e...@ex... Do not Disturb \n" + " c...@ex... Offline \n" + "__________________________________\n" + "\n" + )) + +(rd-clear-roster) + +;; More Quickcheck test cases. +(dolist (input '((iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "b...@ex...")) (group () "b") ))) + (iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "c...@ex...")) (group () "b") ))) + (iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "a...@ex...")) ))) + (presence ((from . "b...@ex...")) (show () "away")) + (presence ((from . "c...@ex...") (type . "unavailable"))) + (presence ((from . "a...@ex...")) (show () "dnd")) + (iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "a...@ex...")) (group () "b") ))))) + (jabber-process-input (car jabber-connections) input)) + +(rd-check-roster-buffer) + +(rd-compare + "More ordering issues" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "b\n" + " * b...@ex... Away \n" + " * a...@ex... Do not Disturb \n" + " c...@ex... Offline \n" + "__________________________________\n" + "\n" + )) + +(rd-clear-roster) + +(dolist (input '((iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "c...@ex...")) (group () "b")))) + (presence ((from . "c...@ex...")) (show () "away")) + (iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "e...@ex...")) (group () "b")))) + (presence ((from . "e...@ex..."))) + (iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "a...@ex...")) (group () "b")))) + (presence ((from . "c...@ex...") (type . "unavailable"))) + )) + (jabber-process-input (car jabber-connections) input)) + +(rd-check-roster-buffer) + +(rd-compare + "Yet another ordering issue" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "b\n" + " * e...@ex... Online \n" + " a...@ex... Offline \n" + " c...@ex... Offline \n" + "__________________________________\n" + "\n" + )) ----------------------------------------------------------------------- Summary of changes: jabber-roster.el | 103 ++++++++++++++++++++++----------------- tests/load-all.el | 1 + tests/roster-display.el | 121 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 180 insertions(+), 45 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-04-09 22:57: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, roster-optimisation has been created at 9bf8d47f8caa8c346beb45501293650347836794 (commit) - Log ----------------------------------------------------------------- commit 9bf8d47f8caa8c346beb45501293650347836794 Author: Magnus Henoch <mag...@gm...> Date: Thu Apr 9 21:13:03 2015 +0100 Sort contacts in incremental roster redisplay Also add corresponding tests. diff --git a/jabber-roster.el b/jabber-roster.el index 1dfb409..9c16241 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -861,16 +861,46 @@ three being lists of JID symbols." (entry (gethash buddy buddy-ewoc-node-hash)) (current-groups (or (get buddy 'groups) (list jabber-roster-default-group-name))) - (to-be-removed - (remove-if - (lambda (node) - (member (caar (ewoc-data node)) current-groups)) - entry)) - (to-be-updated - (set-difference entry to-be-removed))) - (mapc delete-roster-item to-be-removed) - (apply #'ewoc-invalidate ewoc to-be-updated) - (puthash buddy to-be-updated buddy-ewoc-node-hash))))))) + new-entry) + (dolist (node entry) + (if (not (member (caar (ewoc-data node)) current-groups)) + ;; If the contact has been removed from a roster group, + ;; just remove from display under that roster group. + (funcall delete-roster-item node) + ;; Check if the sort order has changed. + (cond + ;; Should the item move up? + ((let ((previous (ewoc-prev ewoc node)) + insert-before) + (while (let ((previous-buddy (and previous (cadr (ewoc-data previous))))) + (when (and previous-buddy + (jabber-roster-sort-items buddy previous-buddy)) + (setq insert-before previous) + (setq previous (ewoc-prev ewoc previous)) + t))) + (when insert-before + (let ((data (ewoc-data node))) + (ewoc-delete ewoc node) + (push (ewoc-enter-before ewoc insert-before data) new-entry))))) + ;; Should the item move down? + ((let ((next (ewoc-next ewoc node)) + insert-after) + (while (let ((next-buddy (and next (cadr (ewoc-data next))))) + (when (and next-buddy + (jabber-roster-sort-items next-buddy buddy)) + (setq insert-after next) + (setq next (ewoc-next ewoc next)) + t))) + (when insert-after + (let ((data (ewoc-data node))) + (ewoc-delete ewoc node) + (push (ewoc-enter-after ewoc insert-after data) new-entry))))) + ;; Or should it be updated in place? + (t + (ewoc-invalidate ewoc node) + (push node new-entry))))) + ;; Update hash table with new ewoc node list. + (puthash buddy new-entry buddy-ewoc-node-hash))))))) (defalias 'jabber-presence-update-roster 'ignore) ;;jabber-presence-update-roster is not needed anymore. diff --git a/tests/roster-display.el b/tests/roster-display.el index 9ee56fb..c16f7c8 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -377,3 +377,88 @@ " * ju...@ca... Online \n" "__________________________________\n" "\n")) + +;;; More than one contact + +(setq jabber-show-offline-contacts t) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "mer...@ca...")) + (group () "Capulets"))))) + +(rd-check-roster-buffer) + +(rd-compare + "Two contacts in separate groups" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Capulets\n" + " mer...@ca... Offline \n" + "Lovers\n" + " * ju...@ca... Online \n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "ju...@ca...")) + (group () "Capulets") + (group () "Lovers"))))) + +(rd-check-roster-buffer) + +(rd-compare + "One contact in both groups" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Capulets\n" + " * ju...@ca... Online \n" + " mer...@ca... Offline \n" + "Lovers\n" + " * ju...@ca... Online \n" + "__________________________________\n" + "\n")) + +(trace-function-background 'jabber-roster-sort-items "*trace*") + +(jabber-process-input + (car jabber-connections) + '(presence ((from . "mer...@ca.../balcony")) + (show () "chat"))) + +(rd-check-roster-buffer) + +(rd-compare + "Chatty contact ordered first" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Capulets\n" + " * mer...@ca... Chatty \n" + " * ju...@ca... Online \n" + "Lovers\n" + " * ju...@ca... Online \n" + "__________________________________\n" + "\n")) commit 794362d2b703825055fb283292e87b21800f46f6 Author: Magnus Henoch <mag...@gm...> Date: Thu Apr 9 11:20:30 2015 +0100 Use remove-if-not instead of cl-remove-if-not The cl- name was introduced in 24.3, but we still want to support Emacs 23. diff --git a/jabber-roster.el b/jabber-roster.el index a7efb33..1dfb409 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -815,13 +815,13 @@ three being lists of JID symbols." ;; should be added/removed. (unless jabber-show-offline-contacts (let* ((actually-added - (cl-remove-if-not + (remove-if-not (lambda (buddy) (and (jabber-roster--display-item-p buddy) (not (gethash buddy buddy-ewoc-node-hash)))) changed-items)) (actually-removed - (cl-remove-if-not + (remove-if-not (lambda (buddy) (and (not (jabber-roster--display-item-p buddy)) (gethash buddy buddy-ewoc-node-hash))) commit 1e82016cce811dcecd81c4f52cf670e123a4545d Author: Magnus Henoch <mag...@gm...> Date: Thu Apr 9 11:11:56 2015 +0100 Use defadvice instead of advice-add for roster display test advice-add was added in Emacs 24.4. Let's support running the test on previous versions. diff --git a/tests/roster-display.el b/tests/roster-display.el index e70885e..9ee56fb 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -5,14 +5,13 @@ (setq jabber-roster-debug t) ;; Ensure that errors are logged -(advice-add 'jabber-roster-update :around - (lambda (oldfun &rest r) - (condition-case e - (apply oldfun r) - (error - (princ "error in jabber-roster-update!\n") - (princ (error-message-string e)) - (signal (car e) (cdr e)))))) +(defadvice jabber-roster-update (around log-errors activate) + (condition-case e + ad-do-it + (error + (princ "error in jabber-roster-update!\n") + (princ (error-message-string e)) + (signal (car e) (cdr e))))) (trace-function-background 'jabber-roster-update "*trace*") (trace-function-background 'fsm-send-sync "*trace*") commit 40acdf8f5403d0edf112e53a4096c58b9c280ac7 Author: Magnus Henoch <mag...@gm...> Date: Thu Apr 9 10:54:59 2015 +0100 Print test suite log when tests fail in Travis diff --git a/.travis.yml b/.travis.yml index 4f08543..22d210f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -13,4 +13,5 @@ script: - automake --version - autoreconf -i - ./configure - - make all check + - make all + - make check VERBOSE=yes commit f5fb07b194c3599d1a7c7966d48799d58dd3557d Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 8 21:38:57 2015 +0100 First attempt at more efficient roster redisplay If we're not adding any entries, only updating or removing them, don't redraw the entire roster buffer, just change the ewoc items that need changing. Keep ewoc nodes in hash tables for fast lookup. diff --git a/jabber-roster.el b/jabber-roster.el index ddec536..a7efb33 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -581,7 +581,11 @@ H Toggle displaying this text 'face 'jabber-title-medium) "\n__________________________________\n") "__________________________________")) - (new-groups '())) + (new-groups '()) + (buddy-ewoc-node-hash (make-hash-table :test 'equal)) + (group-ewoc-node-hash (make-hash-table :test 'equal))) + (plist-put (fsm-get-state-data jc) :buddy-ewoc-node-hash buddy-ewoc-node-hash) + (plist-put (fsm-get-state-data jc) :group-ewoc-node-hash group-ewoc-node-hash) (plist-put(fsm-get-state-data jc) :roster-ewoc ewoc) (dolist (group (plist-get (fsm-get-state-data jc) :roster-groups)) (let* ((group-name (car group)) @@ -591,12 +595,16 @@ H Toggle displaying this text (when (or jabber-roster-show-empty-group (> (length buddies) 0)) (let ((group-node (ewoc-enter-last ewoc (list group nil)))) + (puthash group group-node group-ewoc-node-hash) (if (not (find group-name (plist-get (fsm-get-state-data jc) :roster-roll-groups) :test 'string=)) (dolist (buddy (reverse buddies)) - (ewoc-enter-after ewoc group-node (list group buddy)))))))) + (let ((new-node + (ewoc-enter-after ewoc group-node (list group buddy))) + (entry (gethash buddy buddy-ewoc-node-hash))) + (puthash buddy (cons new-node entry) buddy-ewoc-node-hash)))))))) (goto-char (point-max)) (insert "\n") (put-text-property before-ewoc (point) @@ -730,24 +738,10 @@ three being lists of JID symbols." (hash (plist-get (fsm-get-state-data jc) :roster-hash)) (ewoc (plist-get (fsm-get-state-data jc) :roster-ewoc)) (all-groups (plist-get (fsm-get-state-data jc) :roster-groups)) - (terminator - (lambda (deleted-items) - (dolist (delete-this deleted-items) - (let ((groups (get delete-this 'groups)) - (terminator - (lambda (g) - (let* - ((group (or g jabber-roster-default-group-name)) - (buddies (gethash group hash))) - (when (not buddies) - (setq new-groups (append new-groups (list group)))) - (puthash group - (delq delete-this buddies) - hash))))) - (if groups - (dolist (group groups) - (terminator group)) - (terminator groups))))))) + (buddy-ewoc-node-hash (plist-get (fsm-get-state-data jc) :buddy-ewoc-node-hash)) + (group-ewoc-node-hash (plist-get (fsm-get-state-data jc) :group-ewoc-node-hash)) + ;; Currently we need to redraw the roster when items are added. + (need-redraw (not (null new-items)))) ;; fix a old-roster (dolist (delete-this deleted-items) @@ -776,11 +770,19 @@ three being lists of JID symbols." ;; insert changed-items (dolist (insert-this (append changed-items new-items)) - (let ((jid (symbol-name insert-this))) + (let* ((jid (symbol-name insert-this)) + (existing-ewoc-data (mapcar #'ewoc-data (gethash insert-this buddy-ewoc-node-hash))) + (old-groups (mapcar #'caar existing-ewoc-data)) + (new-groups (or (get insert-this 'groups) + (list jabber-roster-default-group-name)))) + ;; If a contact is added to a group, we currently need to + ;; redraw the entire roster buffer. + (setq need-redraw + (or need-redraw + (not (null (set-difference new-groups old-groups :test #'string=))))) (when jabber-roster-debug (message (concat "insert jid: " jid))) - (dolist (group (or (get insert-this 'groups) - (list jabber-roster-default-group-name))) + (dolist (group new-groups) (when jabber-roster-debug (message (concat "insert jid: " jid " to group " group))) (puthash group @@ -804,8 +806,71 @@ three being lists of JID symbols." (when jabber-roster-debug (message "re display roster")) - ;; recreate roster buffer - (jabber-display-roster))) + (if (or (null ewoc) need-redraw) + ;; Recreate roster buffer if there is no ewoc, or if items + ;; have been added. + ;; TODO: handle added items more gracefully. + (jabber-display-roster) + ;; If we're not showing offline contacts, figure out which items + ;; should be added/removed. + (unless jabber-show-offline-contacts + (let* ((actually-added + (cl-remove-if-not + (lambda (buddy) + (and (jabber-roster--display-item-p buddy) + (not (gethash buddy buddy-ewoc-node-hash)))) + changed-items)) + (actually-removed + (cl-remove-if-not + (lambda (buddy) + (and (not (jabber-roster--display-item-p buddy)) + (gethash buddy buddy-ewoc-node-hash))) + changed-items))) + (setq changed-items (set-difference changed-items actually-added)) + (setq changed-items (set-difference changed-items actually-removed)) + (setq new-items (append actually-added new-items)) + (setq deleted-items (append actually-removed deleted-items)))) + + (let ((delete-roster-item + (lambda (node) + (let ((previous (ewoc-prev ewoc node)) + (next (ewoc-next ewoc node))) + (ewoc-delete ewoc node) + (when (and + ;; Was the previous ewoc node a group node? + (null (cadr (ewoc-data previous))) + ;; And is the following node also a group node, + ;; or the end of the ewoc? + (or (null next) (null (cadr (ewoc-data next))))) + ;; That means that we just emptied a group. Let's + ;; remove the preceding group heading. + (ewoc-delete ewoc previous)))))) + ;; changed-items and deleted-items are lists of symbols. Let's + ;; look them up in buddy-ewoc-node-hash. + (dolist (buddy deleted-items) + ;; Because a contact can be in multiple groups, there might be + ;; several ewoc items. + (let ((inhibit-read-only t) + (entry (gethash buddy buddy-ewoc-node-hash))) + (mapc delete-roster-item entry) + (remhash buddy buddy-ewoc-node-hash))) + ;; Hm, what is the ewoc data exactly? It's a list, (GROUP BUDDY). + ;; BUDDY is a symbol, so it already contains all relevant data. + (dolist (buddy changed-items) + (let* ((inhibit-read-only t) + (entry (gethash buddy buddy-ewoc-node-hash)) + (current-groups (or (get buddy 'groups) + (list jabber-roster-default-group-name))) + (to-be-removed + (remove-if + (lambda (node) + (member (caar (ewoc-data node)) current-groups)) + entry)) + (to-be-updated + (set-difference entry to-be-removed))) + (mapc delete-roster-item to-be-removed) + (apply #'ewoc-invalidate ewoc to-be-updated) + (puthash buddy to-be-updated buddy-ewoc-node-hash))))))) (defalias 'jabber-presence-update-roster 'ignore) ;;jabber-presence-update-roster is not needed anymore. commit d68187dc490882fd2d9cc4ca57d419b8e7404f12 Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 8 21:33:53 2015 +0100 Factor out jabber-roster--display-item-p diff --git a/jabber-roster.el b/jabber-roster.el index 6b2f18f..ddec536 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -491,11 +491,12 @@ See `jabber-sort-order' for order used." There is only one; we don't rely on buffer-local variables or such.") +(defun jabber-roster--display-item-p (buddy) + (or jabber-show-offline-contacts (get buddy 'connected))) + (defun jabber-roster-filter-display (buddies) "Filter BUDDIES for items to be displayed in the roster" - (remove-if-not (lambda (buddy) (or jabber-show-offline-contacts - (get buddy 'connected))) - buddies)) + (remove-if-not #'jabber-roster--display-item-p buddies)) (defun jabber-roster-toggle-offline-display () "Toggle display of offline contacts. commit c241638e73accce7ae3a96b6d991d74083de9d3e Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 8 21:33:01 2015 +0100 More debug output for roster display test diff --git a/tests/roster-display.el b/tests/roster-display.el index cafebed..e70885e 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -2,6 +2,20 @@ (require 'cl) (setq jabber-roster-show-bindings nil) +(setq jabber-roster-debug t) + +;; Ensure that errors are logged +(advice-add 'jabber-roster-update :around + (lambda (oldfun &rest r) + (condition-case e + (apply oldfun r) + (error + (princ "error in jabber-roster-update!\n") + (princ (error-message-string e)) + (signal (car e) (cdr e)))))) + +(trace-function-background 'jabber-roster-update "*trace*") +(trace-function-background 'fsm-send-sync "*trace*") ;; jabber-post-connect-hooks is run after the roster has been drawn ;; for the first time - but jabber-send-presence will redraw the @@ -37,6 +51,8 @@ (prin1 (substring rd-roster-string 0 result)) (princ " ***mismatch here*** ") (prin1 (substring rd-roster-string result)) + (princ (with-current-buffer "*fsm-debug*" (buffer-string))) + (princ (with-current-buffer "*trace*" (buffer-string))) (error "Mismatch")))) (jabberd-connect) commit 467a028f99637886b83fb42a7623f1460809f029 Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 8 11:37:49 2015 +0100 Test roster display with offline contacts hidden diff --git a/tests/roster-display.el b/tests/roster-display.el index 28a2392..cafebed 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -224,3 +224,141 @@ "\n" "__________________________________\n" "\n")) + +;;; Hiding offline contacts + +(setq jabber-show-offline-contacts nil) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "ju...@ca...")))))) + +(rd-check-roster-buffer) + +(rd-compare + "One contact (offline)" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(presence ((from . "ju...@ca.../balcony")))) + +(rd-check-roster-buffer) + +(rd-compare + "Contact goes online" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "other\n" + " * ju...@ca... Online \n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "ju...@ca...")) + (group () "Capulets") + (group () "Lovers"))))) + +(rd-check-roster-buffer) + +(rd-compare + "Contact in two groups" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Capulets\n" + " * ju...@ca... Online \n" + "Lovers\n" + " * ju...@ca... Online \n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "ju...@ca...")) + (group () "Lovers"))))) + +(rd-check-roster-buffer) + +(rd-compare + "Contact moved to one group" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Lovers\n" + " * ju...@ca... Online \n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(presence ((from . "ju...@ca.../balcony") + (type . "unavailable")))) + +(rd-check-roster-buffer) + +(rd-compare + "Contact goes offline (offline contacts hidden)" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(presence ((from . "ju...@ca.../balcony")))) + +(rd-check-roster-buffer) + +(rd-compare + "Contact goes online again" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Lovers\n" + " * ju...@ca... Online \n" + "__________________________________\n" + "\n")) commit 029b602cd1b0f6157384fa867cf4a7ed52a68151 Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 8 11:23:37 2015 +0100 Test contact going offline diff --git a/tests/roster-display.el b/tests/roster-display.el index 5b12fdd..28a2392 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -183,6 +183,28 @@ (jabber-process-input (car jabber-connections) + '(presence ((from . "ju...@ca.../balcony") + (type . "unavailable")))) + +(rd-check-roster-buffer) + +(rd-compare + "Contact goes offline" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Lovers\n" + " ju...@ca... Offline \n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) '(iq ((type . "set")) (query ((xmlns . "jabber:iq:roster")) (item ((jid . "ju...@ca...") commit 1dbb381105214ba8a10e3942841e131f60d5786c Author: Magnus Henoch <mag...@gm...> Date: Tue Apr 7 10:36:48 2015 +0100 Wait for or force relevant roster changes in roster-display test Put them in the rd-check-roster-buffer function, so we can't miss them. diff --git a/tests/roster-display.el b/tests/roster-display.el index 85d24c9..5b12fdd 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -13,6 +13,13 @@ (defvar rd-roster-string nil) (defun rd-check-roster-buffer (&optional _jc) + ;; The presence stanza causes an asynchronous :roster-update message + ;; to be sent. Let's wait for that. + (accept-process-output nil 0.1) + + ;; Roster updates are batched. Force a timeout. + (fsm-send-sync (car jabber-connections) :timeout) + (with-current-buffer jabber-roster-buffer (let ((contents (buffer-string))) (set-text-properties 0 (length contents) () contents) @@ -131,9 +138,6 @@ (car jabber-connections) '(presence ((from . "ju...@ca.../balcony")))) -;; Roster updates are batched. Force a timeout. -(fsm-send-sync (car jabber-connections) :timeout) - (rd-check-roster-buffer) (rd-compare commit d04ad63ad2c6517bce04d4780aac8613b02a6ae9 Author: Magnus Henoch <mag...@gm...> Date: Fri Apr 3 19:49:54 2015 +0100 Use :key arguments to simplify the code diff --git a/jabber-roster.el b/jabber-roster.el index c7ba74b..6b2f18f 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -791,18 +791,11 @@ three being lists of JID symbols." (when jabber-roster-debug (message "remove duplicates from new group")) - (setq all-groups (sort + (setq all-groups (sort* (remove-duplicates all-groups - :test (lambda (g1 g2) - (let ((g1-name (car g1)) - (g2-name (car g2))) - (string= g1-name - g2-name)))) - (lambda (g1 g2) - (let ((g1-name (car g1)) - (g2-name (car g2))) - (string< g1-name - g2-name))))) + :test #'string= + :key #'car) + #'string< :key #'car)) (plist-put (fsm-get-state-data jc) :roster-groups all-groups)) commit 74420285a69be2361d7389294d97b240ee834c9a Author: Magnus Henoch <mag...@gm...> Date: Fri Apr 3 19:44:15 2015 +0100 Use function symbols instead of lambdas where possible It looks tidier, and is probably a tiny tiny bit faster. diff --git a/jabber-roster.el b/jabber-roster.el index b62b182..c7ba74b 100644 --- a/jabber-roster.el +++ b/jabber-roster.el @@ -766,7 +766,7 @@ three being lists of JID symbols." (let ((jid (symbol-name delete-this))) (when jabber-roster-debug (message (concat "delete jid: " jid))) - (dolist (group (mapcar (lambda (g) (car g)) all-groups)) + (dolist (group (mapcar #'car all-groups)) (when jabber-roster-debug (message (concat "try to delete jid: " jid " from group " group))) (puthash group @@ -880,7 +880,7 @@ If optional PREV is non-nil, return position of previous property appearence." (let* ((groups (plist-get (fsm-get-state-data jc) :roster-roll-groups)) (roll-groups (if groups - (mapconcat (lambda (a) (substring-no-properties a)) groups "\n") + (mapconcat #'substring-no-properties groups "\n") ""))) (jabber-private-set jc `(roster ((xmlns . "emacs-jabber")) commit e1eaa4331a56f060af9eedd15f48fcf69d9be8fd Author: Magnus Henoch <mag...@gm...> Date: Thu Apr 2 18:56:04 2015 +0100 More roster display tests diff --git a/tests/roster-display.el b/tests/roster-display.el index 0b30300..85d24c9 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -75,3 +75,126 @@ " ju...@ca... Offline \n" "__________________________________\n" "\n")) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "ju...@ca...")) + (group () "Capulets"))))) + +(rd-check-roster-buffer) + +(rd-compare + "One contact in one group" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Capulets\n" + " ju...@ca... Offline \n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "ju...@ca...")) + (group () "Capulets") + (group () "Lovers"))))) + +(rd-check-roster-buffer) + +(rd-compare + "One contact in two groups" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Capulets\n" + " ju...@ca... Offline \n" + "Lovers\n" + " ju...@ca... Offline \n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(presence ((from . "ju...@ca.../balcony")))) + +;; Roster updates are batched. Force a timeout. +(fsm-send-sync (car jabber-connections) :timeout) + +(rd-check-roster-buffer) + +(rd-compare + "Contact goes online" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Capulets\n" + " * ju...@ca... Online \n" + "Lovers\n" + " * ju...@ca... Online \n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "ju...@ca...")) + (group () "Lovers"))))) + +(rd-check-roster-buffer) + +(rd-compare + "Contact moved to one group" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "Lovers\n" + " * ju...@ca... Online \n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "ju...@ca...") + (subscription . "remove")))))) + +(rd-check-roster-buffer) + +(rd-compare + "Contact deleted" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "__________________________________\n" + "\n")) commit 6f54ef927b2c872e723658420266079105decc0e Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 1 20:01:49 2015 +0100 Test display of roster with one contact diff --git a/tests/roster-display.el b/tests/roster-display.el index 2be1208..0b30300 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -12,18 +12,6 @@ (defvar rd-roster-string nil) -(defconst rd-expected-roster - (concat - "Jabber roster\n" - "__________________________________\n" - "\n" - " - Online -\n" - "ro...@mo...\n" - "__________________________________\n" - "\n" - "__________________________________\n" - "\n")) - (defun rd-check-roster-buffer (&optional _jc) (with-current-buffer jabber-roster-buffer (let ((contents (buffer-string))) @@ -52,4 +40,38 @@ (while (not (and rd-roster-string (equal "" *jabber-current-show*))) (sit-for 0.1))) -(rd-compare "Empty roster" rd-expected-roster) +(rd-compare + "Empty roster" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "__________________________________\n" + "\n")) + +(jabber-process-input + (car jabber-connections) + '(iq ((type . "set")) + (query ((xmlns . "jabber:iq:roster")) + (item ((jid . "ju...@ca...")))))) + +(rd-check-roster-buffer) + +(rd-compare + "One contact" + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Online -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "other\n" + " ju...@ca... Offline \n" + "__________________________________\n" + "\n")) commit 71e7352c09cea930c59206e7bce96bea327465ba Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 1 19:58:27 2015 +0100 Improve roster display test Check roster buffer after our presence state has been updated. Point out where the mismatch is when a test fails. Display contents of *fsm-debug* buffer if we cannot "connect". diff --git a/tests/roster-display.el b/tests/roster-display.el index a616094..2be1208 100644 --- a/tests/roster-display.el +++ b/tests/roster-display.el @@ -1,9 +1,14 @@ (require 'jabberd) +(require 'cl) (setq jabber-roster-show-bindings nil) -;; jabber-post-connect-hooks is run after the roster has been drawn. -(add-hook 'jabber-post-connect-hooks 'rd-check-roster-buffer) +;; jabber-post-connect-hooks is run after the roster has been drawn +;; for the first time - but jabber-send-presence will redraw the +;; roster buffer after sending initial presence! Make sure we check +;; the roster buffer after that has happened, so that the roster +;; buffer displays "Online" for ourselves already. +(add-hook 'jabber-post-connect-hooks 'rd-check-roster-buffer :append) (defvar rd-roster-string nil) @@ -12,25 +17,39 @@ "Jabber roster\n" "__________________________________\n" "\n" - " - Offline -\n" + " - Online -\n" "ro...@mo...\n" "__________________________________\n" "\n" "__________________________________\n" "\n")) -(defun rd-check-roster-buffer (_jc) +(defun rd-check-roster-buffer (&optional _jc) (with-current-buffer jabber-roster-buffer (let ((contents (buffer-string))) (set-text-properties 0 (length contents) () contents) - (prin1 contents) (setq rd-roster-string contents)))) +(defun rd-compare (title expected) + (princ title) + (princ "...") + (let ((result (mismatch rd-roster-string expected))) + (if (null result) + (princ "match\n") + (princ "mismatch! Expected:\n") + (prin1 expected) + (princ "\nBut got:\n") + (prin1 (substring rd-roster-string 0 result)) + (princ " ***mismatch here*** ") + (prin1 (substring rd-roster-string result)) + (error "Mismatch")))) + (jabberd-connect) -(with-timeout (5 (error "Timeout")) - (while (not rd-roster-string) +(with-timeout (5 (progn + (princ (with-current-buffer "*fsm-debug*" (buffer-string))) + (error "Timeout"))) + (while (not (and rd-roster-string (equal "" *jabber-current-show*))) (sit-for 0.1))) -(unless (equal rd-roster-string rd-expected-roster) - (error "Bad roster")) +(rd-compare "Empty roster" rd-expected-roster) commit c28359d51faf80780b83ba99e3d850440dfbb145 Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 1 19:56:44 2015 +0100 Load jabber-autoloads for tests Not all modules are loaded by (require 'jabber). diff --git a/tests/jabberd.el b/tests/jabberd.el index 0985687..ec31550 100644 --- a/tests/jabberd.el +++ b/tests/jabberd.el @@ -3,6 +3,7 @@ ;;; actual tests. (require 'jabber) +(require 'jabber-autoloads) (require 'cl) (defvar jabberd-stanza-handlers '(jabberd-sasl jabberd-iq) commit c456905b2af55310ba0f056bc82e0209ff9703cd Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 1 11:05:53 2015 +0100 Add test for display of empty roster To be expanded. diff --git a/tests/Makefile.am b/tests/Makefile.am index 8575ddb..216b4ff 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -2,5 +2,5 @@ # check" or "make distcheck" to work with earlier versions. LOG_COMPILER = env top_builddir=$(top_builddir) $(EMACS) -batch -L $(top_builddir) -L $(top_srcdir) -L $(srcdir) -l TESTS = load-all.el skip-tag-forward.el history.el jabberd.el nick-change-fail.el -TESTS += caps-hash.el +TESTS += caps-hash.el roster-display.el dist_noinst_DATA = $(TESTS) diff --git a/tests/roster-display.el b/tests/roster-display.el new file mode 100644 index 0000000..a616094 --- /dev/null +++ b/tests/roster-display.el @@ -0,0 +1,36 @@ +(require 'jabberd) + +(setq jabber-roster-show-bindings nil) + +;; jabber-post-connect-hooks is run after the roster has been drawn. +(add-hook 'jabber-post-connect-hooks 'rd-check-roster-buffer) + +(defvar rd-roster-string nil) + +(defconst rd-expected-roster + (concat + "Jabber roster\n" + "__________________________________\n" + "\n" + " - Offline -\n" + "ro...@mo...\n" + "__________________________________\n" + "\n" + "__________________________________\n" + "\n")) + +(defun rd-check-roster-buffer (_jc) + (with-current-buffer jabber-roster-buffer + (let ((contents (buffer-string))) + (set-text-properties 0 (length contents) () contents) + (prin1 contents) + (setq rd-roster-string contents)))) + +(jabberd-connect) + +(with-timeout (5 (error "Timeout")) + (while (not rd-roster-string) + (sit-for 0.1))) + +(unless (equal rd-roster-string rd-expected-roster) + (error "Bad roster")) commit b643661ed9e157dc298b3be9ad2f45c5397ac5da Author: Magnus Henoch <mag...@gm...> Date: Wed Apr 1 11:05:27 2015 +0100 Add test log files to gitignore diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..e2f3fd3 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,2 @@ +*.log +*.trs \ No newline at end of file ----------------------------------------------------------------------- hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-03-31 21:35:11
|
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 d9bbe9ba024557b1f9afd274a93964f192ebe871 (commit) from 787d3bdba70e717218afb8189b3ae7d4d7e4b8fb (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 d9bbe9ba024557b1f9afd274a93964f192ebe871 Author: Magnus Henoch <mag...@gm...> Date: Tue Mar 31 22:34:07 2015 +0100 Don't look for query-dns The function query-dns was renamed to dns-query before the Emacs 23 release, so there is no point in checking for it. diff --git a/srv.el b/srv.el index 6ead479..d5455bb 100644 --- a/srv.el +++ b/srv.el @@ -46,7 +46,6 @@ of the list. The list is empty if no SRV records were found." (error "No dns.el available")) (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 (srv--dns-query target)) (answers (mapcar #'(lambda (a) (cadr (assq 'data a))) @@ -98,9 +97,7 @@ of the list. The list is empty if no SRV records were found." (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)) + (dns-query target 'SRV t) ;; ...so let's call nslookup instead. (srv--nslookup target))) ----------------------------------------------------------------------- Summary of changes: srv.el | 5 +---- 1 files changed, 1 insertions(+), 4 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-03-05 12:18: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, master has been updated via 787d3bdba70e717218afb8189b3ae7d4d7e4b8fb (commit) via 5b65c87dc05a23d1d1995e447ccd7ac3c9b8efa1 (commit) via a9238d2b045f3452ee8a2c14903a5c5760ac77e6 (commit) via 255f6804aff9dd8b58bfaed5d751d141647c4993 (commit) via 04a683d8b2f894380579f7cb4b6f1d1b5147e2cd (commit) via fd80b92552c0131b2cfd5c1368445b0950f1d749 (commit) via 1f5bc9548e1767a25689afcf073ec3ae71d42245 (commit) via ad667999ee2f65709c18e6af235c7f2e0dd65007 (commit) via e33a361a0f324f8bd3c8e3dc54e2ae15d0dc7f9b (commit) via bc212947ff13119dcb161f0c920c8f906e2594c4 (commit) via 38ee56392bb03bbcf2b3260aec1a4141f3078b24 (commit) via cc8d30f7e1849f40d242274b9f37b648868574bb (commit) via d2b369ea018b390ff23e8b05f9e676e0b01bf889 (commit) from 1a46db7f4b4b51925138557355395f70f440e66b (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 787d3bdba70e717218afb8189b3ae7d4d7e4b8fb Merge: 5b65c87 04a683d Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 10:50:48 2015 +0000 Merge branch 'travis' Compile and run tests automatically using Travis CI. commit 5b65c87dc05a23d1d1995e447ccd7ac3c9b8efa1 Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 10:48:35 2015 +0000 Don't assume jabber-account-list is bound in menu test Just in case jabber-menu.el gets loaded without jabber.el or jabber-autoloads.el. diff --git a/jabber-menu.el b/jabber-menu.el index 528181e..40082ee 100644 --- a/jabber-menu.el +++ b/jabber-menu.el @@ -155,7 +155,7 @@ With prefix argument, remove it." `(or (eq jabber-display-menu t) (and (eq jabber-display-menu 'maybe) (or ,user-installed-package - jabber-account-list + (bound-and-true-p jabber-account-list) (bound-and-true-p jabber-connections))))))) (defvar jabber-jid-chat-menu nil commit a9238d2b045f3452ee8a2c14903a5c5760ac77e6 Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 01:37:31 2015 +0000 Add test for jabber-disco hashing Use example from XEP-0115. diff --git a/tests/Makefile.am b/tests/Makefile.am index 01f07e0..8575ddb 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -2,4 +2,5 @@ # check" or "make distcheck" to work with earlier versions. LOG_COMPILER = env top_builddir=$(top_builddir) $(EMACS) -batch -L $(top_builddir) -L $(top_srcdir) -L $(srcdir) -l TESTS = load-all.el skip-tag-forward.el history.el jabberd.el nick-change-fail.el +TESTS += caps-hash.el dist_noinst_DATA = $(TESTS) diff --git a/tests/caps-hash.el b/tests/caps-hash.el new file mode 100644 index 0000000..55d18b9 --- /dev/null +++ b/tests/caps-hash.el @@ -0,0 +1,51 @@ +;; Test disco hash against examples in XEP-0115 + +(message "Let's go") +(condition-case e + (require 'jabber-disco) + (error + (message "disco bad! %S" e))) +(message "more") +(condition-case e + (require 'jabber-widget) + (error + (message "bad! %S" e))) +(message "done!") + +(let ((query + (with-temp-buffer + (insert "<query xmlns='http://jabber.org/protocol/disco#info' + node='http://psi-im.org#q07IKJEyjvHSyhy//CH0CxmKi8w='> + <identity xml:lang='en' category='client' name='Psi 0.11' type='pc'/> + <identity xml:lang='el' category='client' name='Ψ 0.11' type='pc'/> + <feature var='http://jabber.org/protocol/caps'/> + <feature var='http://jabber.org/protocol/disco#info'/> + <feature var='http://jabber.org/protocol/disco#items'/> + <feature var='http://jabber.org/protocol/muc'/> + <x xmlns='jabber:x:data' type='result'> + <field var='FORM_TYPE' type='hidden'> + <value>urn:xmpp:dataforms:softwareinfo</value> + </field> + <field var='ip_version'> + <value>ipv4</value> + <value>ipv6</value> + </field> + <field var='os'> + <value>Mac</value> + </field> + <field var='os_version'> + <value>10.5.1</value> + </field> + <field var='software'> + <value>Psi</value> + </field> + <field var='software_version'> + <value>0.11</value> + </field> + </x> + </query>") + (car (xml-parse-region (point-min) (point-max)))))) + (message "parsed xml") + (unless (equal "q07IKJEyjvHSyhy//CH0CxmKi8w=" + (jabber-caps-ver-string query "sha-1")) + (error "Incorrect caps hash"))) commit 255f6804aff9dd8b58bfaed5d751d141647c4993 Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 01:34:08 2015 +0000 Don't use `features' as a variable This is already a global variable. If a module is loaded, it might be added to our temporary variable instead of the global one. diff --git a/jabber-disco.el b/jabber-disco.el index b538e87..4669e17 100644 --- a/jabber-disco.el +++ b/jabber-disco.el @@ -496,7 +496,7 @@ Return (IDENTITIES FEATURES), or nil if not in cache." ;; 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)) + (disco-features (mapcar (lambda (f) (jabber-xml-get-attribute f 'var)) (jabber-xml-get-children query 'feature))) (maybe-forms (jabber-xml-get-children query 'x)) (forms (remove-if-not @@ -521,11 +521,11 @@ Return (IDENTITIES FEATURES), or nil if not in cache." ;; `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<)) + (setq disco-features (sort disco-features #'string<)) ;; 5. For each feature, append the feature to S, followed by the ;; '<' character. - (dolist (feature features) - (insert feature "<")) + (dolist (f disco-features) + (insert f "<")) ;; 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). commit 04a683d8b2f894380579f7cb4b6f1d1b5147e2cd Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 00:42:59 2015 +0000 Use Automake 1.12 for Travis "make check" doesn't work for Automake 1.11 or earlier. Let's get a newer version from a PPA. diff --git a/.travis.yml b/.travis.yml index 24540d6..4f08543 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,10 +4,13 @@ env: before_install: # PPA for stable Emacs packages - sudo add-apt-repository -y ppa:cassou/emacs + # PPA for Automake 1.12 + - sudo add-apt-repository -y ppa:dns/gnu - sudo apt-get update -qq - - sudo apt-get install -qq -yy ${EMACS}-nox texinfo + - sudo apt-get install -qq -yy ${EMACS}-nox texinfo automake script: - emacs --version + - automake --version - autoreconf -i - ./configure - make all check commit fd80b92552c0131b2cfd5c1368445b0950f1d749 Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 00:22:44 2015 +0000 Use "make all check" for Travis "make distcheck" requires TeX to be installed. Let's not bother with that. diff --git a/.travis.yml b/.travis.yml index 6696933..24540d6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -10,4 +10,4 @@ script: - emacs --version - autoreconf -i - ./configure - - make distcheck + - make all check commit 1f5bc9548e1767a25689afcf073ec3ae71d42245 Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 00:11:16 2015 +0000 Need to install texinfo for Travis build to succeed diff --git a/.travis.yml b/.travis.yml index f854218..6696933 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,7 +5,7 @@ before_install: # PPA for stable Emacs packages - sudo add-apt-repository -y ppa:cassou/emacs - sudo apt-get update -qq - - sudo apt-get install -qq -yy ${EMACS}-nox + - sudo apt-get install -qq -yy ${EMACS}-nox texinfo script: - emacs --version - autoreconf -i commit ad667999ee2f65709c18e6af235c7f2e0dd65007 Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 00:04:37 2015 +0000 Call configure before make for Travis diff --git a/.travis.yml b/.travis.yml index ef96de8..f854218 100644 --- a/.travis.yml +++ b/.travis.yml @@ -9,4 +9,5 @@ before_install: script: - emacs --version - autoreconf -i + - ./configure - make distcheck commit e33a361a0f324f8bd3c8e3dc54e2ae15d0dc7f9b Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 00:03:23 2015 +0000 Need PPA to install Emacs 24 for Travis diff --git a/.travis.yml b/.travis.yml index 5fa8ad8..ef96de8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,6 +2,8 @@ env: - EMACS=emacs23 - EMACS=emacs24 before_install: + # PPA for stable Emacs packages + - sudo add-apt-repository -y ppa:cassou/emacs - sudo apt-get update -qq - sudo apt-get install -qq -yy ${EMACS}-nox script: commit bc212947ff13119dcb161f0c920c8f906e2594c4 Author: Magnus Henoch <mag...@gm...> Date: Thu Mar 5 00:01:22 2015 +0000 Forgot to call autoreconf in .travis.yml diff --git a/.travis.yml b/.travis.yml index 961235c..5fa8ad8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -6,4 +6,5 @@ before_install: - sudo apt-get install -qq -yy ${EMACS}-nox script: - emacs --version + - autoreconf -i - make distcheck commit 38ee56392bb03bbcf2b3260aec1a4141f3078b24 Author: Magnus Henoch <mag...@gm...> Date: Wed Mar 4 23:54:38 2015 +0000 Initial attempt at .travis.yml file Adapted from https://github.com/abo-abo/tiny/blob/master/.travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..961235c --- /dev/null +++ b/.travis.yml @@ -0,0 +1,9 @@ +env: + - EMACS=emacs23 + - EMACS=emacs24 +before_install: + - sudo apt-get update -qq + - sudo apt-get install -qq -yy ${EMACS}-nox +script: + - emacs --version + - make distcheck commit cc8d30f7e1849f40d242274b9f37b648868574bb Author: Adam Sjøgren <as...@ko...> Date: Mon Feb 9 17:04:29 2015 +0100 Scale avatars if width/height is above a value. If ImageMagick support is available. diff --git a/jabber-avatar.el b/jabber-avatar.el index e3dcbca..ac02523 100644 --- a/jabber-avatar.el +++ b/jabber-avatar.el @@ -52,6 +52,16 @@ :group 'jabber-avatar :type 'boolean) +(defcustom jabber-avatar-max-width 96 + "Maximum width of avatars." + :group 'jabber-avatar + :type 'integer) + +(defcustom jabber-avatar-max-height 96 + "Maximum height of avatars." + :group 'jabber-avatar + :type 'integer) + ;;;; Avatar data handling (defstruct avatar sha1-sum mime-type url base64-data height width bytes) @@ -97,7 +107,7 @@ If MIME-TYPE is not specified, try to find it from the image data." (base64-data (or base64-string (base64-encode-string raw-data))) (type (or mime-type (cdr (assq (get :type (cdr (condition-case nil - (create-image data nil t) + (jabber-create-image data nil t) (error nil)))) '((png "image/png") (jpeg "image/jpeg") @@ -118,7 +128,7 @@ If MIME-TYPE is not specified, try to find it from the image data." "Create an image from AVATAR. Return nil if images of this type are not supported." (condition-case nil - (create-image (with-temp-buffer + (jabber-create-image (with-temp-buffer (set-buffer-multibyte nil) (insert (avatar-base64-data avatar)) (base64-decode-region (point-min) (point-max)) @@ -194,7 +204,7 @@ AVATAR may be one of: (setq hash avatar) (setq image (lambda () (condition-case nil - (create-image (jabber-avatar-find-cached avatar)) + (jabber-create-image (jabber-avatar-find-cached avatar)) (error nil))))) (t (setq hash nil) @@ -205,5 +215,20 @@ AVATAR may be one of: (put jid-symbol 'avatar-hash hash) (jabber-presence-update-roster jid-symbol)))) +(defun jabber-create-image (file-or-data &optional type data-p) + "Create image, scaled down to jabber-avatar-max-width/height, +if width/height exceeds either of those, and ImageMagick is +available." + (let* ((image (create-image file-or-data type data-p)) + (size (image-size image t)) + (spec (cdr image))) + (when (and (functionp 'imagemagick-types) + (or (> (car size) jabber-avatar-max-width) + (> (cdr size) jabber-avatar-max-height))) + (plist-put spec :type 'imagemagick) + (plist-put spec :width jabber-avatar-max-width) + (plist-put spec :height jabber-avatar-max-height)) + image)) + (provide 'jabber-avatar) ;; arch-tag: 2405c3f8-8eaa-11da-826c-000a95c2fcd0 diff --git a/jabber-vcard.el b/jabber-vcard.el index fd347da..aab91cd 100644 --- a/jabber-vcard.el +++ b/jabber-vcard.el @@ -396,7 +396,7 @@ The top node should be the `vCard' node." (when (and photo-type photo-binval) (condition-case nil ;; ignore the type, let create-image figure it out. - (let ((image (create-image (base64-decode-string photo-binval) nil t))) + (let ((image (jabber-create-image (base64-decode-string photo-binval) nil t))) (insert-image image "[Photo]") (insert "\n")) (error (insert "Couldn't display photo\n"))))))) commit d2b369ea018b390ff23e8b05f9e676e0b01bf889 Author: Magnus Henoch <mag...@gm...> Date: Wed Mar 4 23:32:10 2015 +0000 Fix capabilities hash for Emacs 23 Emacs 23 doesn't have the function secure-hash. Fall back to the sha1 function. Thanks to Andres Ramirez Ramos for reporting this bug. diff --git a/jabber-disco.el b/jabber-disco.el index cab427f..b538e87 100644 --- a/jabber-disco.el +++ b/jabber-disco.el @@ -360,11 +360,16 @@ invalidate cache and get fresh data." (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)) + (if (fboundp 'secure-hash) + '(("sha-1" . sha1) + ("sha-224" . sha224) + ("sha-256" . sha256) + ("sha-384" . sha384) + ("sha-512" . sha512)) + ;; `secure-hash' was introduced in Emacs 24. For Emacs 23, fall + ;; back to the `sha1' function, handled specially in + ;; `jabber-caps--secure-hash'. + '(("sha-1" . sha1))) "Hash function name map. Maps names defined in http://www.iana.org/assignments/hash-function-text-names to symbols accepted by `secure-hash'. @@ -562,7 +567,18 @@ Return (IDENTITIES FEATURES), or nil if not in cache." ;; 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)))) + (base64-encode-string (jabber-caps--secure-hash algorithm s) t)))) + +(defun jabber-caps--secure-hash (algorithm string) + (cond + ;; `secure-hash' was introduced in Emacs 24 + ((fboundp 'secure-hash) + (secure-hash algorithm string nil nil t)) + ((eq algorithm 'sha1) + ;; For SHA-1, we can use the `sha1' function. + (sha1 string nil nil t)) + (t + (error "Cannot use hash algorithm %s!" algorithm)))) (defun jabber-caps-identity-< (a b) (let ((a-category (jabber-xml-get-attribute a 'category)) ----------------------------------------------------------------------- Summary of changes: .travis.yml | 16 ++++++++++++++++ jabber-avatar.el | 31 ++++++++++++++++++++++++++++--- jabber-disco.el | 36 ++++++++++++++++++++++++++---------- jabber-menu.el | 2 +- jabber-vcard.el | 2 +- tests/Makefile.am | 1 + tests/caps-hash.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 124 insertions(+), 15 deletions(-) create mode 100644 .travis.yml create mode 100644 tests/caps-hash.el hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-02-11 21:32:32
|
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 1a46db7f4b4b51925138557355395f70f440e66b (commit) via 5d5528b993a8bbb80db6dd6a3cf96fe558eeaf98 (commit) from 11f665108db5da5a4510991703cb733084cf7a29 (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 1a46db7f4b4b51925138557355395f70f440e66b Author: Magnus Henoch <mag...@gm...> Date: Wed Feb 11 21:30:58 2015 +0000 Remove unused function The flet-bound function nonempty is not used anymore. diff --git a/jabber-core.el b/jabber-core.el index e0351d3..1a44e8a 100644 --- a/jabber-core.el +++ b/jabber-core.el @@ -192,48 +192,45 @@ With double prefix argument, specify more connection details." (entry (assoc jid jabber-account-list)) (alist (cdr entry)) password network-server port connection-type registerp) - (flet ((nonempty - (s) - (unless (zerop (length s)) s))) - (when entry - ;; If the user entered the JID of one of the preconfigured - ;; accounts, use that data. - (setq password (cdr (assq :password alist))) - (setq network-server (cdr (assq :network-server alist))) - (setq port (cdr (assq :port alist))) - (setq connection-type (cdr (assq :connection-type alist)))) - (when (equal current-prefix-arg '(16)) - ;; Double prefix arg: ask about everything. - ;; (except password, which is asked about later anyway) - (setq password nil) - (setq network-server - (read-string (format "Network server: (default `%s') " network-server) - nil nil network-server)) - (when (zerop (length network-server)) - (setq network-server nil)) - (setq port - (car - (read-from-string - (read-string (format "Port: (default `%s') " port) - nil nil (if port (number-to-string port) "nil"))))) - (setq connection-type - (car - (read-from-string - (let ((default (symbol-name (or connection-type jabber-default-connection-type)))) - (completing-read - (format "Connection type: (default `%s') " default) - (mapcar (lambda (type) - (cons (symbol-name (car type)) nil)) - jabber-connect-methods) - nil t nil 'jabber-connection-type-history default))))) - (setq registerp (or jabber-silent-mode (yes-or-no-p "Register new account? ")))) - (when (equal current-prefix-arg '(4)) - (setq registerp t)) - - (list (jabber-jid-username jid) - (jabber-jid-server jid) - (jabber-jid-resource jid) - registerp password network-server port connection-type)))) + (when entry + ;; If the user entered the JID of one of the preconfigured + ;; accounts, use that data. + (setq password (cdr (assq :password alist))) + (setq network-server (cdr (assq :network-server alist))) + (setq port (cdr (assq :port alist))) + (setq connection-type (cdr (assq :connection-type alist)))) + (when (equal current-prefix-arg '(16)) + ;; Double prefix arg: ask about everything. + ;; (except password, which is asked about later anyway) + (setq password nil) + (setq network-server + (read-string (format "Network server: (default `%s') " network-server) + nil nil network-server)) + (when (zerop (length network-server)) + (setq network-server nil)) + (setq port + (car + (read-from-string + (read-string (format "Port: (default `%s') " port) + nil nil (if port (number-to-string port) "nil"))))) + (setq connection-type + (car + (read-from-string + (let ((default (symbol-name (or connection-type jabber-default-connection-type)))) + (completing-read + (format "Connection type: (default `%s') " default) + (mapcar (lambda (type) + (cons (symbol-name (car type)) nil)) + jabber-connect-methods) + nil t nil 'jabber-connection-type-history default))))) + (setq registerp (or jabber-silent-mode (yes-or-no-p "Register new account? ")))) + (when (equal current-prefix-arg '(4)) + (setq registerp t)) + + (list (jabber-jid-username jid) + (jabber-jid-server jid) + (jabber-jid-resource jid) + registerp password network-server port connection-type))) (require 'jabber) commit 5d5528b993a8bbb80db6dd6a3cf96fe558eeaf98 Author: Magnus Henoch <mag...@gm...> Date: Wed Feb 11 21:28:37 2015 +0000 Use let instead of labels In recent Emacs versions, `labels' only provides lexical binding if the variable lexical-binding is set to t. Avoid the problem by assigning the functions to simple variables and passing them to jabber-send-iq. diff --git a/jabber-core.el b/jabber-core.el index 5796e99..e0351d3 100644 --- a/jabber-core.el +++ b/jabber-core.el @@ -641,21 +641,20 @@ With double prefix argument, specify more connection details." ;; Record stream features, discarding earlier data: (setq state-data (plist-put state-data :stream-features stanza)) (if (jabber-xml-get-children stanza 'bind) - (labels - ((handle-bind - (jc xml-data success) - (fsm-send jc (list - (if success :bind-success :bind-failure) - xml-data)))) - ;; So let's bind a resource. We can either pick a resource ourselves, - ;; or have the server pick one for us. - (let ((resource (plist-get state-data :resource))) - (jabber-send-iq fsm nil "set" - `(bind ((xmlns . "urn:ietf:params:xml:ns:xmpp-bind")) - ,@(when resource - `((resource () ,resource)))) - #'handle-bind t - #'handle-bind nil)) + (let ((handle-bind + (lambda (jc xml-data success) + (fsm-send jc (list + (if success :bind-success :bind-failure) + xml-data)))) + ;; So let's bind a resource. We can either pick a resource ourselves, + ;; or have the server pick one for us. + (resource (plist-get state-data :resource))) + (jabber-send-iq fsm nil "set" + `(bind ((xmlns . "urn:ietf:params:xml:ns:xmpp-bind")) + ,@(when resource + `((resource () ,resource)))) + handle-bind t + handle-bind nil) (list :bind state-data)) (message "Server doesn't permit resource binding") (list nil state-data))) @@ -677,16 +676,15 @@ With double prefix argument, specify more connection details." ;; offer session initiation here. If it follows RFCs 6120 and ;; 6121, it might not offer it, and we should just skip it. (if (jabber-xml-get-children (plist-get state-data :stream-features) 'session) - (labels - ((handle-session - (jc xml-data success) - (fsm-send jc (list - (if success :session-success :session-failure) - xml-data)))) + (let ((handle-session + (lambda (jc xml-data success) + (fsm-send jc (list + (if success :session-success :session-failure) + xml-data))))) (jabber-send-iq fsm nil "set" '(session ((xmlns . "urn:ietf:params:xml:ns:xmpp-session"))) - #'handle-session t - #'handle-session nil) + handle-session t + handle-session nil) (list :bind state-data)) ;; Session establishment not offered - assume not necessary. (list :session-established state-data))) ----------------------------------------------------------------------- Summary of changes: jabber-core.el | 125 +++++++++++++++++++++++++++----------------------------- 1 files changed, 60 insertions(+), 65 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-02-09 11:25:35
|
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 11f665108db5da5a4510991703cb733084cf7a29 (commit) via a7ca3f0efacbdf4b2fa478ea7db8be7ebf0a426f (commit) from e2494578ff798b23eefc3f113a0819387c898e49 (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 11f665108db5da5a4510991703cb733084cf7a29 Author: Magnus Henoch <mag...@gm...> Date: Mon Feb 9 10:29:39 2015 +0000 Use contact hint in jabber-chat-with When asking for account, default to an account that has the provided JID in its roster, if any. diff --git a/jabber-chat.el b/jabber-chat.el index f27af4b..e6486f1 100644 --- a/jabber-chat.el +++ b/jabber-chat.el @@ -654,10 +654,10 @@ If DONT-PRINT-NICK-P is true, don't include nickname." "Open an empty chat window for chatting with JID. With a prefix argument, open buffer in other window. Returns the chat buffer." - (interactive (let ((jid + (interactive (let* ((jid (jabber-read-jid-completing "chat with:")) - (account - (jabber-read-account))) + (account + (jabber-read-account nil jid))) (list account jid current-prefix-arg))) (let ((buffer (jabber-chat-create-buffer jc jid))) commit a7ca3f0efacbdf4b2fa478ea7db8be7ebf0a426f Author: Magnus Henoch <mag...@gm...> Date: Mon Feb 9 10:28:55 2015 +0000 Add contact-hint optional argument to jabber-read-account If specified, default to an account that has the given JID in its roster. diff --git a/jabber-util.el b/jabber-util.el index 049eca6..b6e1304 100644 --- a/jabber-util.el +++ b/jabber-util.el @@ -21,7 +21,7 @@ ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -(eval-when-compile (require 'cl)) +(require 'cl) (condition-case nil (require 'password) (error nil)) @@ -348,10 +348,12 @@ Useful if the password proved to be wrong." (when (fboundp 'password-cache-remove) (password-cache-remove (jabber-password-key bare-jid)))) -(defun jabber-read-account (&optional always-ask) +(defun jabber-read-account (&optional always-ask contact-hint) "Ask for which connected account to use. If ALWAYS-ASK is nil and there is only one account, return that -account." +account. +If CONTACT-HINT is a string or a JID symbol, default to an account +that has that contact in its roster." (let ((completions (mapcar (lambda (c) (cons @@ -374,6 +376,15 @@ account." (jabber-connection-bare-jid at-point))) completions)) (let* ((default (or + (and contact-hint + (setq contact-hint (jabber-jid-symbol contact-hint)) + (let ((matching + (find-if + (lambda (jc) + (memq contact-hint (plist-get (fsm-get-state-data jc) :roster))) + jabber-connections))) + (when matching + (jabber-connection-bare-jid matching)))) ;; if the buffer is associated with a connection, use it (when (and jabber-buffer-connection (memq jabber-buffer-connection jabber-connections)) ----------------------------------------------------------------------- Summary of changes: jabber-chat.el | 6 +++--- jabber-util.el | 17 ++++++++++++++--- 2 files changed, 17 insertions(+), 6 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2015-01-27 15:46:04
|
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 e2494578ff798b23eefc3f113a0819387c898e49 (commit) via 783dbeeaa22ed8e8f533f0227a1b98c65aef9f26 (commit) from 4d9d8908089faf9cfa0456f023169239b476a510 (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 e2494578ff798b23eefc3f113a0819387c898e49 Merge: 4d9d890 783dbee Author: Magnus Henoch <mag...@er...> Date: Tue Jan 27 15:45:09 2015 +0000 Merge pull request #4 from Flowdalic/xmpp Replace jabber(.org) which xmpp(.org) commit 783dbeeaa22ed8e8f533f0227a1b98c65aef9f26 Author: Florian Schmaus <fl...@ge...> Date: Tue Jan 27 16:28:19 2015 +0100 Replace jabber(.org) which xmpp(.org) where appropriate. There are still some places left where this could be done, mostly UI strings where 'Jabber' could be replaced with 'XMPP (Jabber)'. diff --git a/README b/README index 63fba02..2e2849a 100644 --- a/README +++ b/README @@ -1,6 +1,6 @@ -This is jabber.el 0.8.92, a Jabber client for Emacs. Jabber (also known -as XMPP) is an instant messaging system; see http://www.jabber.org for -more information. +This is jabber.el 0.8.92, an XMPP client for Emacs. XMPP (also +known as 'Jabber') is an instant messaging system; see +http://xmpp.org for more information. Home page: http://emacs-jabber.sourceforge.net Project page: http://sourceforge.net/projects/emacs-jabber diff --git a/debian/control b/debian/control index 9559cac..455f4bd 100644 --- a/debian/control +++ b/debian/control @@ -9,9 +9,9 @@ Package: emacs-jabber Architecture: all Depends: gnus (>= 5.10.6-1.NO.20050713-1) | flim | emacs-snapshot | emacs22 Description: Jabber client for Emacs/XEmacs - jabber.el (emacs-jabber) is a Jabber client for Emacs and XEmacs. + jabber.el (emacs-jabber) is an XMPP (Jabber) client for Emacs and XEmacs. . - Jabber is an open instant messaging system. For more information on - Jabber, see http://www.jabber.org/. + XMPP is an open instant messaging system. For more information on + XMPP, see http://xmpp.org/. . Homepage: http://emacs-jabber.sourceforge.net/ diff --git a/jabber.texi b/jabber.texi index d85d5da..128b551 100644 --- a/jabber.texi +++ b/jabber.texi @@ -6,7 +6,7 @@ @dircategory Emacs @direntry -* jabber.el: (jabber). Emacs Jabber client +* jabber.el: (jabber). Emacs XMPP (Jabber) client @end direntry @copying @@ -23,7 +23,7 @@ this permission notice are preserved on all copies. @titlepage @title jabber.el -@subtitle instant messaging for Jabber +@subtitle instant messaging for XMPP (Jabber) @author by Magnus Henoch and Tom Berger @page @@ -68,11 +68,11 @@ this permission notice are preserved on all copies. @node Introduction, Basic operation, Top, Top @chapter Introduction -jabber.el is a Jabber client running under Emacs. For more -information on the open-protocol instant messaging network Jabber, -please visit @uref{http://www.jabber.org}. +jabber.el is an XMPP (Jabber) client running under Emacs. For more +information on the open instant messaging protocol, +please visit @uref{http://xmpp.org}. -As a Jabber client, jabber.el is mostly just a face in the crowd, +As a XMPP client, jabber.el is mostly just a face in the crowd, except that it uses buffers where GUI clients have windows. There is a roster buffer, and to chat with someone you open a chat buffer, and there are buffers for @@ -117,7 +117,7 @@ jabber-muc-join} and entering the address. @chapter Basic operation This chapter is intended as an introduction to basic usage of -jabber.el. If you have used Jabber before and are familiar with the +jabber.el. If you have used XMPP before and are familiar with the terminology, you might find it a bit too basic---in that case, just skim it, making sure to pick up the commands mentioned. ----------------------------------------------------------------------- Summary of changes: README | 6 +++--- debian/control | 6 +++--- jabber.texi | 14 +++++++------- 3 files changed, 13 insertions(+), 13 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2014-12-24 00:25: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, master has been updated via 4d9d8908089faf9cfa0456f023169239b476a510 (commit) from 3f0c7c842fe0a2127e265fa2b95be0f19c1f860b (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 4d9d8908089faf9cfa0456f023169239b476a510 Author: Magnus Henoch <mag...@gm...> Date: Wed Dec 24 00:24:38 2014 +0000 Forgot to update error message diff --git a/jabber-core.el b/jabber-core.el index 4c6c3c2..5796e99 100644 --- a/jabber-core.el +++ b/jabber-core.el @@ -657,7 +657,7 @@ With double prefix argument, specify more connection details." #'handle-bind t #'handle-bind nil)) (list :bind state-data)) - (message "Server doesn't permit resource binding and session establishing") + (message "Server doesn't permit resource binding") (list nil state-data))) (t (or ----------------------------------------------------------------------- Summary of changes: jabber-core.el | 2 +- 1 files changed, 1 insertions(+), 1 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2014-12-24 00:17:25
|
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 3f0c7c842fe0a2127e265fa2b95be0f19c1f860b (commit) via dd30666bb5aced367675604c46d1d32bf25255c7 (commit) from 262602e1b7e97922420832cba00c54d9966b13c5 (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 3f0c7c842fe0a2127e265fa2b95be0f19c1f860b Author: Magnus Henoch <mag...@gm...> Date: Wed Dec 24 00:15:50 2014 +0000 Handle server not offering session establishment Session establishment was removed in RFCs 6120 and 6121. Some servers still offer it for backwards compatibility, but some don't. Let's be compatible with the latter. diff --git a/jabber-core.el b/jabber-core.el index 4c757c8..4c6c3c2 100644 --- a/jabber-core.el +++ b/jabber-core.el @@ -640,8 +640,7 @@ With double prefix argument, specify more connection details." ((eq (jabber-xml-node-name stanza) 'features) ;; Record stream features, discarding earlier data: (setq state-data (plist-put state-data :stream-features stanza)) - (if (and (jabber-xml-get-children stanza 'bind) - (jabber-xml-get-children stanza 'session)) + (if (jabber-xml-get-children stanza 'bind) (labels ((handle-bind (jc xml-data success) @@ -674,18 +673,23 @@ With double prefix argument, specify more connection details." (plist-put state-data :server (jabber-jid-server jid)) (plist-put state-data :resource (jabber-jid-resource jid))) - ;; Been there, done that. Time to establish a session. - (labels - ((handle-session - (jc xml-data success) - (fsm-send jc (list - (if success :session-success :session-failure) - xml-data)))) - (jabber-send-iq fsm nil "set" - '(session ((xmlns . "urn:ietf:params:xml:ns:xmpp-session"))) - #'handle-session t - #'handle-session nil) - (list :bind state-data))) + ;; If the server follows the older RFCs 3920 and 3921, it may + ;; offer session initiation here. If it follows RFCs 6120 and + ;; 6121, it might not offer it, and we should just skip it. + (if (jabber-xml-get-children (plist-get state-data :stream-features) 'session) + (labels + ((handle-session + (jc xml-data success) + (fsm-send jc (list + (if success :session-success :session-failure) + xml-data)))) + (jabber-send-iq fsm nil "set" + '(session ((xmlns . "urn:ietf:params:xml:ns:xmpp-session"))) + #'handle-session t + #'handle-session nil) + (list :bind state-data)) + ;; Session establishment not offered - assume not necessary. + (list :session-established state-data))) (:session-success ;; We have a session commit dd30666bb5aced367675604c46d1d32bf25255c7 Author: Magnus Henoch <mag...@gm...> Date: Fri Nov 21 21:26:12 2014 +0000 Clarify docstring for fsm-debug-output Explicitly refer to the variable, not the function provided by distel. diff --git a/fsm.el b/fsm.el index b7f6225..4bc4ebf 100644 --- a/fsm.el +++ b/fsm.el @@ -117,7 +117,7 @@ Default format is whatever `current-time-string' returns followed by a colon and a space.") (defun fsm-debug-output (format &rest args) - "Append debug output to buffer named by `fsm-debug'. + "Append debug output to buffer named by the variable `fsm-debug'. FORMAT and ARGS are passed to `format'." (when fsm-debug (with-current-buffer (get-buffer-create fsm-debug) ----------------------------------------------------------------------- Summary of changes: fsm.el | 2 +- jabber-core.el | 32 ++++++++++++++++++-------------- 2 files changed, 19 insertions(+), 15 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2014-10-31 18:58:38
|
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 262602e1b7e97922420832cba00c54d9966b13c5 (commit) from 4891befb7d947c132dfd8b0de4a322d8751f9d0f (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 262602e1b7e97922420832cba00c54d9966b13c5 Author: Magnus Henoch <mag...@gm...> Date: Fri Oct 31 18:55:56 2014 +0000 Allow inhibiting history entries for incoming messages New variable `jabber-history-inhibit-received-message-functions' can contain a list of functions. If any of them returns non-nil, the given incoming message is not included in the message history. diff --git a/jabber-history.el b/jabber-history.el index 53953b8..a1e8250 100644 --- a/jabber-history.el +++ b/jabber-history.el @@ -92,6 +92,12 @@ number after the last rotation." :type 'integer :group 'jabber-history) +(defvar jabber-history-inhibit-received-message-functions nil + "Functions determining whether to log an incoming message stanza. +The functions in this list are called with two arguments, +the connection and the full message stanza. +If any of the functions returns non-nil, the stanza is not logged +in the message history.") (defun jabber-rotate-history-p (history-file) "Return true if HISTORY-FILE should be rotated." @@ -114,16 +120,19 @@ number after the last rotation." (not (file-directory-p jabber-history-dir))) (make-directory jabber-history-dir)) (let ((is-muc (jabber-muc-message-p xml-data))) - (if (and jabber-history-enabled - (or - (not is-muc) ;chat message or private MUC message - (and jabber-history-muc-enabled is-muc))) ;muc message and muc logging active - (let ((from (jabber-xml-get-attribute xml-data 'from)) - (text (car (jabber-xml-node-children - (car (jabber-xml-get-children xml-data 'body))))) - (timestamp (jabber-message-timestamp xml-data))) - (when (and from text) - (jabber-history-log-message "in" from nil text timestamp)))))) + (when (and jabber-history-enabled + (or + (not is-muc) ;chat message or private MUC message + (and jabber-history-muc-enabled is-muc))) ;muc message and muc logging active + (unless (run-hook-with-args-until-success + 'jabber-history-inhibit-received-message-functions + jc xml-data) + (let ((from (jabber-xml-get-attribute xml-data 'from)) + (text (car (jabber-xml-node-children + (car (jabber-xml-get-children xml-data 'body))))) + (timestamp (jabber-message-timestamp xml-data))) + (when (and from text) + (jabber-history-log-message "in" from nil text timestamp))))))) (add-hook 'jabber-chat-send-hooks 'jabber-history-send-hook) ----------------------------------------------------------------------- Summary of changes: jabber-history.el | 29 +++++++++++++++++++---------- 1 files changed, 19 insertions(+), 10 deletions(-) hooks/post-receive -- emacs-jabber |
From: Magnus H. <leg...@us...> - 2014-09-30 19:09: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 4891befb7d947c132dfd8b0de4a322d8751f9d0f (commit) from 2ada81d8664763700430d3e6aa9ea776e712631a (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 4891befb7d947c132dfd8b0de4a322d8751f9d0f Author: Magnus Henoch <mag...@gm...> Date: Tue Sep 30 20:08:32 2014 +0100 Display nickname for contacts added to / removed from roster diff --git a/jabber-presence.el b/jabber-presence.el index 1809abd..5f4573d 100644 --- a/jabber-presence.el +++ b/jabber-presence.el @@ -66,7 +66,9 @@ CLOSURE-DATA should be 'initial if initial roster push, nil otherwise." ;; If subscripton="remove", contact is to be removed from roster (if (string= (jabber-xml-get-attribute item 'subscription) "remove") (progn - (message "%s removed from roster" jid) + (if (jabber-jid-rostername jid) + (message "%s (%s) removed from roster" (jabber-jid-rostername jid) jid) + (message "%s removed from roster" jid)) (push jid deleted-items)) ;; Find contact if already in roster @@ -76,7 +78,9 @@ CLOSURE-DATA should be 'initial if initial roster push, nil otherwise." (push roster-item changed-items) ;; If not found, create a new roster item. (unless (eq closure-data 'initial) - (message "%s added to roster" jid)) + (if (jabber-xml-get-attribute item 'name) + (message "%s (%s) added to roster" (jabber-xml-get-attribute item 'name) jid) + (message "%s added to roster" jid))) (setq roster-item jid) (push roster-item new-items)) ----------------------------------------------------------------------- Summary of changes: jabber-presence.el | 8 ++++++-- 1 files changed, 6 insertions(+), 2 deletions(-) hooks/post-receive -- emacs-jabber |