Commit c7b7425e authored by Paul Eggert's avatar Paul Eggert
Browse files

Merge from mainline.

parents 5c1ccb01 c4354cb4
......@@ -228,7 +228,7 @@
2011-04-06 Juanma Barranquero <lekktu@gmail.com>
* files.el (after-find-file-from-revert-buffer): Remove variable.
(after-find-file): Dont' bind it.
(after-find-file): Don't bind it.
(revert-buffer-in-progress-p): New variable.
(revert-buffer): Bind it.
Pass nil for `after-find-file-from-revert-buffer'.
......
2011-04-16 Teodor Zlatanov <tzz@lifelogs.com>
* registry.el (registry-reindex): New method to recreate the secondary
registry indices.
* gnus-registry.el (gnus-registry-fixup-registry): Use it if the
tracked field changes.
(gnus-registry-unfollowed-addresses, gnus-registry-track-extra)
(gnus-registry-action, gnus-registry-spool-action)
(gnus-registry-handle-action)
(gnus-registry--split-fancy-with-parent-internal)
(gnus-registry-split-fancy-with-parent)
(gnus-registry-register-message-ids): Add recipient tracking on spool,
move, and delete actions, and for fancy splitting with parent.
(gnus-registry-extract-addresses)
(gnus-registry-fetch-recipients-fast)
(gnus-registry-fetch-header-fast): Convenience functions.
(gnus-registry-misc-test): ERT test of
`gnus-registry-extract-addresses'.
2011-04-15 Teodor Zlatanov <tzz@lifelogs.com>
 
* gnus-registry.el (gnus-registry--split-fancy-with-parent-internal):
......
......@@ -36,7 +36,7 @@
;; Put this in your startup file (~/.gnus.el for instance) or use Customize:
;; (setq gnus-registry-max-entries 2500
;; gnus-registry-track-extra '(sender subject))
;; gnus-registry-track-extra '(sender subject recipient))
;; (gnus-registry-initialize)
......@@ -119,7 +119,9 @@ display.")
(defcustom gnus-registry-unfollowed-addresses
(list (regexp-quote user-mail-address))
"List of addresses that gnus-registry-split-fancy-with-parent won't trace.
The addresses are matched, they don't have to be fully qualified."
The addresses are matched, they don't have to be fully qualified.
In the messages, these addresses can be the sender or the
recipients."
:group 'gnus-registry
:type '(repeat regexp))
......@@ -152,14 +154,15 @@ nnmairix groups are specifically excluded because they are ephemeral."
(make-obsolete-variable 'gnus-registry-entry-caching nil "23.4")
(make-obsolete-variable 'gnus-registry-trim-articles-without-groups nil "23.4")
(defcustom gnus-registry-track-extra '(subject sender)
(defcustom gnus-registry-track-extra '(subject sender recipient)
"Whether the registry should track extra data about a message.
The Subject and Sender (From:) headers are tracked this way by
default."
The subject, recipients (To: and Cc:), and Sender (From:) headers
are tracked this way by default."
:group 'gnus-registry
:type
'(set :tag "Tracking choices"
(const :tag "Track by subject (Subject: header)" subject)
(const :tag "Track by recipient (To: and Cc: headers)" recipient)
(const :tag "Track by sender (From: header)" sender)))
(defcustom gnus-registry-split-strategy nil
......@@ -224,18 +227,22 @@ the Bit Bucket."
(defun gnus-registry-fixup-registry (db)
(when db
(oset db :precious
(append gnus-registry-extra-entries-precious
'()))
(oset db :max-hard
(or gnus-registry-max-entries
most-positive-fixnum))
(oset db :max-soft
(or gnus-registry-max-pruned-entries
most-positive-fixnum))
(oset db :tracked
(append gnus-registry-track-extra
'(mark group keyword))))
(let ((old (oref db :tracked)))
(oset db :precious
(append gnus-registry-extra-entries-precious
'()))
(oset db :max-hard
(or gnus-registry-max-entries
most-positive-fixnum))
(oset db :max-soft
(or gnus-registry-max-pruned-entries
most-positive-fixnum))
(oset db :tracked
(append gnus-registry-track-extra
'(mark group keyword)))
(when (not (equal old (oref db :tracked)))
(gnus-message 4 "Reindexing the Gnus registry (tracked change)")
(registry-reindex db))))
db)
(defun gnus-registry-make-db (&optional file)
......@@ -296,7 +303,17 @@ This is not required after changing `gnus-registry-cache-file'."
(defun gnus-registry-action (action data-header from &optional to method)
(let* ((id (mail-header-id data-header))
(subject (mail-header-subject data-header))
(sender (mail-header-from data-header))
(recipients (sort (mapcan 'gnus-registry-extract-addresses
(list
(or (ignore-errors
(mail-header "Cc" data-header))
"")
(or (ignore-errors
(mail-header "To" data-header))
"")))
'string-lessp))
(sender (nth 0 (gnus-registry-extract-addresses
(mail-header-from data-header))))
(from (gnus-group-guess-full-name-from-command-method from))
(to (if to (gnus-group-guess-full-name-from-command-method to) nil))
(to-name (if to to "the Bit Bucket")))
......@@ -307,10 +324,16 @@ This is not required after changing `gnus-registry-cache-file'."
id
;; unless copying, remove the old "from" group
(if (not (equal 'copy action)) from nil)
to subject sender)))
to subject sender recipients)))
(defun gnus-registry-spool-action (id group &optional subject sender)
(defun gnus-registry-spool-action (id group &optional subject sender recipients)
(let ((to (gnus-group-guess-full-name-from-command-method group))
(recipients (or recipients
(sort (mapcan 'gnus-registry-extract-addresses
(list
(or (message-fetch-field "cc") "")
(or (message-fetch-field "to") "")))
'string-lessp)))
(subject (or subject (message-fetch-field "subject")))
(sender (or sender (message-fetch-field "from"))))
(when (and (stringp id) (string-match "\r$" id))
......@@ -318,12 +341,13 @@ This is not required after changing `gnus-registry-cache-file'."
(gnus-message 7 "Gnus registry: article %s spooled to %s"
id
to)
(gnus-registry-handle-action id nil to subject sender)))
(gnus-registry-handle-action id nil to subject sender recipients)))
(defun gnus-registry-handle-action (id from to subject sender)
(defun gnus-registry-handle-action (id from to subject sender
&optional recipients)
(gnus-message
10
"gnus-registry-handle-action %S" (list id from to subject sender))
"gnus-registry-handle-action %S" (list id from to subject sender recipients))
(let ((db gnus-registry-db)
;; safe if not found
(entry (gnus-registry-get-or-make-entry id))
......@@ -340,11 +364,15 @@ This is not required after changing `gnus-registry-cache-file'."
(setq entry (cons (delete from (assoc 'group entry))
(assq-delete-all 'group entry))))
(dolist (kv `((group ,to) (sender ,sender) (subject ,subject)))
(dolist (kv `((group ,to)
(sender ,sender)
(recipient ,@recipients)
(subject ,subject)))
(when (second kv)
(let ((new (or (assq (first kv) entry)
(list (first kv)))))
(add-to-list 'new (second kv) t)
(dolist (toadd (cdr kv))
(add-to-list 'new toadd t))
(setq entry (cons new
(assq-delete-all (first kv) entry))))))
(gnus-message 10 "Gnus registry: new entry for %s is %S"
......@@ -381,6 +409,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; these may not be used, but the code is cleaner having them up here
(sender (gnus-string-remove-all-properties
(message-fetch-field "from")))
(recipients (sort (mapcan 'gnus-registry-extract-addresses
(list
(or (message-fetch-field "cc") "")
(or (message-fetch-field "to") "")))
'string-lessp))
(subject (gnus-string-remove-all-properties
(gnus-registry-simplify-subject
(message-fetch-field "subject"))))
......@@ -393,12 +426,13 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
:references references
:refstr refstr
:sender sender
:recipients recipients
:subject subject
:log-agent "Gnus registry fancy splitting with parent")))
(defun* gnus-registry--split-fancy-with-parent-internal
(&rest spec
&key references refstr sender subject log-agent
&key references refstr sender subject recipients log-agent
&allow-other-keys)
(gnus-message
10
......@@ -478,6 +512,36 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(setq found (gnus-registry-post-process-groups
"sender" sender found)))
;; else: there were no matches, try the extra tracking by recipient
(when (and (null found)
(memq 'recipient gnus-registry-track-extra)
recipients)
(dolist (recp recipients)
(when (and (null found)
(not (gnus-grep-in-list
recp
gnus-registry-unfollowed-addresses)))
(let ((groups (apply 'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
(registry-lookup-secondary-value
db 'recipient recp)))))
(setq found
(loop for group in groups
when (gnus-registry-follow-group-p group)
do (gnus-message
;; warn more if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
"%s (extra tracking) traced recipient '%s' to %s"
log-agent recp group)
collect group)))))
;; filter the found groups and return them
;; the found groups are NOT the full groups
(setq found (gnus-registry-post-process-groups
"recipients" (mapconcat 'identity recipients ", ") found)))
;; after the (cond) we extract the actual value safely
(car-safe found)))
......@@ -629,7 +693,8 @@ Overrides existing keywords with FORCE set non-nil."
article gnus-newsgroup-name)
(gnus-registry-handle-action id nil gnus-newsgroup-name
(gnus-registry-fetch-simplified-message-subject-fast article)
(gnus-registry-fetch-sender-fast article)))))))
(gnus-registry-fetch-sender-fast article)
(gnus-registry-fetch-recipients-fast article)))))))
;; message field fetchers
(defun gnus-registry-fetch-message-id-fast (article)
......@@ -639,6 +704,21 @@ Overrides existing keywords with FORCE set non-nil."
(mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
(defun gnus-registry-extract-addresses (text)
"Extract all the addresses in a normalized way from TEXT.
Returns an unsorted list of strings in the name <address> format.
Addresses without a name will say \"noname\"."
(mapcar (lambda (add)
(gnus-string-remove-all-properties
(let* ((name (or (nth 0 add) "noname"))
(addr (nth 1 add))
(addr (if (bufferp addr)
(with-current-buffer addr
(buffer-string))
addr)))
(format "%s <%s>" name addr))))
(mail-extract-address-components text t)))
(defun gnus-registry-simplify-subject (subject)
(if (stringp subject)
(gnus-simplify-subject subject)
......@@ -655,12 +735,26 @@ Overrides existing keywords with FORCE set non-nil."
nil))
(defun gnus-registry-fetch-sender-fast (article)
"Fetch the Sender quickly, using the internal gnus-data-list function"
(gnus-registry-fetch-header-fast "from" article))
(defun gnus-registry-fetch-recipients-fast (article)
(sort (mapcan 'gnus-registry-extract-addresses
(list
(or (ignore-errors
(gnus-registry-fetch-header-fast "Cc" article))
"")
(or (ignore-errors
(gnus-registry-fetch-header-fast "To" article))
"")))
'string-lessp))
(defun gnus-registry-fetch-header-fast (article header)
"Fetch the HEADER quickly, using the internal gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(gnus-string-remove-all-properties
(mail-header-from (gnus-data-header
(assoc article (gnus-data-list nil)))))
(mail-header header (gnus-data-header
(assoc article (gnus-data-list nil)))))
nil))
;; registry marks glue
......@@ -902,6 +996,19 @@ only the last one's marks are returned."
(gnus-registry-set-id-key id key val))))
(message "Import done, collected %d entries" count))))
(ert-deftest gnus-registry-misc-test ()
(should-error (gnus-registry-extract-addresses '("" "")))
(should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
"noname <ed@you.me>"
"noname <cyd@stupidchicken.com>"
"noname <tzz@lifelogs.com>")
(gnus-registry-extract-addresses
(concat "Ted Zlatanov <tzz@lifelogs.com>, "
"ed <ed@you.me>, " ; "ed" is not a valid name here
"cyd@stupidchicken.com, "
"tzz@lifelogs.com")))))
(ert-deftest gnus-registry-usage-test ()
(let* ((n 100)
(tempfile (make-temp-file "gnus-registry-persist"))
......
......@@ -281,6 +281,25 @@ Errors out if the key exists already."
(registry-lookup-secondary-value db tr val value-keys))))
entry)
(defmethod registry-reindex ((db registry-db))
"Rebuild the secondary indices of registry-db THIS."
(let ((count 0)
(expected (* (length (oref db :tracked)) (registry-size db))))
(dolist (tr (oref db :tracked))
(let (values)
(maphash
(lambda (key v)
(incf count)
(when (and (< 0 expected)
(= 0 (mod count 1000)))
(message "reindexing: %d of %d (%.2f%%)"
count expected (/ (* 1000 count) expected)))
(dolist (val (cdr-safe (assq tr v)))
(let* ((value-keys (registry-lookup-secondary-value db tr val)))
(push key value-keys)
(registry-lookup-secondary-value db tr val value-keys))))
(oref db :data))))))
(defmethod registry-size ((db registry-db))
"Returns the size of the registry-db object THIS.
This is the key count of the :data slot."
......@@ -360,10 +379,11 @@ Removes only entries without the :precious keys."
(when (boundp 'lexical-binding)
(message "Individual lookup (breaks before lexbind)")
(should (= 58
(caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
(caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
(message "Grouped individual lookup (breaks before lexbind)")
(should (= 3
(length (registry-lookup-breaks-before-lexbind db '(1 58 99))))))
(length (registry-lookup-breaks-before-lexbind db
'(1 58 99))))))
(message "Search")
(should (= n (length (registry-search db :all t))))
(should (= n (length (registry-search db :member '((sender "me"))))))
......
2011-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
* url-http.el (url-http-wait-for-headers-change-function): Protect
against malformed headerless responses from servers.
2011-04-02 Chong Yidong <cyd@stupidchicken.com>
* url-gw.el (url-open-stream): Use new open-network-stream
......
......@@ -1077,6 +1077,10 @@ the end of the document."
(downcase url-http-transfer-encoding)))
(cond
((null url-http-response-status)
;; We got back a headerless malformed response from the
;; server.
(url-http-activate-callback))
((or (= url-http-response-status 204)
(= url-http-response-status 205))
(url-http-debug "%d response must have headers only (%s)."
......
......@@ -101,6 +101,52 @@
* xdisp.c, dispextern.h (set_vertical_scroll_bar): Now extern if
USE_TOOLKIT_SCROLL_BARS && !USE_GTK, as xterm.c needs it then.
2011-04-16 Eli Zaretskii <eliz@gnu.org>
* gnutls.c (Fgnutls_boot): Don't pass Lisp_Object to `error'.
Fix regex.c, syntax.c and friends for buffers > 2GB.
* syntax.h (struct gl_state_s): Declare character position members
EMACS_INT.
* syntax.c (update_syntax_table): Declare 2nd argument EMACS_INT.
* textprop.c (verify_interval_modification, interval_of): Declare
arguments EMACS_INT.
* intervals.c (adjust_intervals_for_insertion): Declare arguments
EMACS_INT.
* intervals.h (CHECK_TOTAL_LENGTH): Cast to EMACS_INT, not `int'.
* indent.c (Fvertical_motion): Local variable it_start is now
EMACS_INT.
* regex.c (re_match, re_match_2, re_match_2_internal)
(bcmp_translate, regcomp, regexec, print_double_string)
(group_in_compile_stack, re_search, re_search_2, regex_compile)
(re_compile_pattern, re_exec): Declare arguments and local
variables `size_t' and `ssize_t' and return values `regoff_t', as
appropriate.
(POP_FAILURE_REG_OR_COUNT) <pfreg>: Declare `long'.
(CHECK_INFINITE_LOOP) <failure>: Declare `ssize_t'.
<compile_stack_type>: `size' and `avail' are now `size_t'.
* regex.h <regoff_t>: Use ssize_t, not int.
(re_search, re_search_2, re_match, re_match_2): Arguments that
specify buffer/string position and length are now ssize_t and
size_t. Return type is regoff_t.
2011-04-16 Ben Key <bkey76@gmail.com>
* nsfont.m: Fixed bugs in ns_get_family and
ns_descriptor_to_entity that were caused by using free to
deallocate memory blocks that were allocated by xmalloc (via
xstrdup). This caused Emacs to crash when compiled with
XMALLOC_OVERRUN_CHECK defined (when Emacs was configured with
--enable-checking=xmallocoverrun). xfree is now used to
deallocate these memory blocks.
2011-04-15 Paul Eggert <eggert@cs.ucla.edu>
* sysdep.c (emacs_read): Remove unnecessary check vs MAX_RW_COUNT.
......@@ -132,10 +178,10 @@
2011-04-15 Ben Key <bkey76@gmail.com>
* keyboard.c (Qundefined): Don't declare static since it is
used in nsfns.m.
* xfaces.c (Qbold, Qexpanded, Qitalic, Qcondensed): Don't
declare static since they are used in nsfont.m.
* keyboard.c (Qundefined): Don't declare static since it is used
in nsfns.m.
* xfaces.c (Qbold, Qexpanded, Qitalic, Qcondensed): Don't declare
static since they are used in nsfont.m.
2011-04-15 Stefan Monnier <monnier@iro.umontreal.ca>
......
......@@ -456,7 +456,7 @@ one trustfile (usually a CA bundle). */)
else
{
error ("Sorry, GnuTLS can't use non-string trustfile %s",
trustfile);
SDATA (trustfile));
}
}
......@@ -478,7 +478,7 @@ one trustfile (usually a CA bundle). */)
else
{
error ("Sorry, GnuTLS can't use non-string keyfile %s",
keyfile);
SDATA (keyfile));
}
}
}
......
......@@ -2026,7 +2026,8 @@ whether or not it is currently displayed in some window. */)
}
else
{
int it_start, first_x, it_overshoot_expected IF_LINT (= 0);
EMACS_INT it_start;
int first_x, it_overshoot_expected IF_LINT (= 0);
SET_TEXT_POS (pt, PT, PT_BYTE);
start_display (&it, w, pt);
......
......@@ -805,9 +805,9 @@ update_interval (register INTERVAL i, EMACS_INT pos)
static INTERVAL
adjust_intervals_for_insertion (tree, position, length)
INTERVAL tree;
int position, length;
EMACS_INT position, length;
{
register int relative_position;
register EMACS_INT relative_position;
register INTERVAL this;
if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
......
......@@ -161,12 +161,12 @@ struct interval
(INTERVAL_HAS_PARENT (i) ? INTERVAL_PARENT (i) : 0)
/* Abort if interval I's size is negative. */
#define CHECK_TOTAL_LENGTH(i) \
do \
{ \
if ((int) (i)->total_length < 0) \
abort (); \
} \
#define CHECK_TOTAL_LENGTH(i) \
do \
{ \
if ((EMACS_INT) (i)->total_length < 0) \
abort (); \
} \
while (0)
/* Reset this interval to its vanilla, or no-property state. */
......@@ -269,7 +269,8 @@ extern INTERVAL merge_interval_left (INTERVAL);
extern void offset_intervals (struct buffer *, EMACS_INT, EMACS_INT);
extern void graft_intervals_into_buffer (INTERVAL, EMACS_INT, EMACS_INT,
struct buffer *, int);
extern void verify_interval_modification (struct buffer *, int, int);
extern void verify_interval_modification (struct buffer *,
EMACS_INT, EMACS_INT);
extern INTERVAL balance_intervals (INTERVAL);
extern void copy_intervals_to_string (Lisp_Object, struct buffer *,
EMACS_INT, EMACS_INT);
......@@ -285,7 +286,7 @@ extern INTERVAL update_interval (INTERVAL, EMACS_INT);
extern void set_intervals_multibyte (int);
extern INTERVAL validate_interval_range (Lisp_Object, Lisp_Object *,
Lisp_Object *, int);
extern INTERVAL interval_of (int, Lisp_Object);
extern INTERVAL interval_of (EMACS_INT, Lisp_Object);
/* Defined in xdisp.c */
extern int invisible_p (Lisp_Object, Lisp_Object);
......
......@@ -104,7 +104,7 @@ static void ns_glyph_metrics (struct nsfont_info *font_info,
NSString *family;
ns_unescape_name (tmp);
family = [NSString stringWithUTF8String: tmp];
free (tmp);
xfree (tmp);
return family;
}
}
......@@ -217,7 +217,7 @@ static void ns_glyph_metrics (struct nsfont_info *font_info,
debug_print (font_entity);
}
free (escapedFamily);
xfree (escapedFamily);
return font_entity;
}
......
......@@ -569,12 +569,12 @@ typedef char boolean;
#define false 0
#define true 1
static int re_match_2_internal _RE_ARGS ((struct re_pattern_buffer *bufp,
re_char *string1, int size1,
re_char *string2, int size2,
int pos,
struct re_registers *regs,
int stop));
static regoff_t re_match_2_internal _RE_ARGS ((struct re_pattern_buffer *bufp,
re_char *string1, size_t size1,
re_char *string2, size_t size2,
ssize_t pos,
struct re_registers *regs,
ssize_t stop));
/* These are the command codes that appear in compiled regular
expressions. Some opcodes are followed by argument bytes. A
......@@ -1230,10 +1230,10 @@ print_double_string (where, string1, size1, string2, size2)
re_char *where;
re_char *string1;
re_char *string2;
int size1;
int size2;
ssize_t size1;
ssize_t size2;
{
int this_char;
ssize_t this_char;
if (where == NULL)
printf ("(null)");
......@@ -1546,7 +1546,7 @@ do { \
/* Pop a saved register off the stack. */
#define POP_FAILURE_REG_OR_COUNT() \
do { \
int pfreg = POP_FAILURE_INT (); \
long pfreg = POP_FAILURE_INT (); \
if (pfreg == -1) \
{ \
/* It's a counter. */ \
......@@ -1568,7 +1568,7 @@ do { \
/* Check that we are not stuck in an infinite loop. */
#define CHECK_INFINITE_LOOP(pat_cur, string_place) \
do { \
int failure = TOP_FAILURE_HANDLE (); \
ssize_t failure = TOP_FAILURE_HANDLE (); \
/* Check for infinite matching loops */ \
while (failure > 0 \
&& (FAILURE_STR (failure) == string_place \
......@@ -1876,8 +1876,8 @@ typedef struct
typedef struct
{
compile_stack_elt_t *stack;
unsigned size;
unsigned avail; /* Offset of next open position. */
size_t size;
size_t avail; /* Offset of next open position. */
} compile_stack_type;
......@@ -2779,7 +2779,7 @@ regex_compile (const re_char *pattern, size_t size, reg_syntax_t syntax, struct
if (many_times_ok)
{
boolean simple = skip_one_char (laststart) == b;
unsigned int startoffset = 0;
size_t startoffset = 0;
re_opcode_t ofj =
/* Check if the loop can match the empty string. */
(simple || !analyse_first (laststart, b, NULL, 0))
......@@ -3361,7 +3361,7 @@ regex_compile (const re_char *pattern, size_t size, reg_syntax_t syntax, struct
_____ _____
| | | |
| v | v
a | b | c
a | b | c
If we are at `b', then fixup_alt_jump right now points to a
three-byte space after `a'. We'll put in the jump, set
......@@ -3905,7 +3905,7 @@ at_endline_loc_p (const re_char *p, const re_char *pend, reg_syntax_t syntax)
static boolean
group_in_compile_stack (compile_stack_type compile_stack, regnum_t regnum)
{
int this_element;