Merge from mainline.

ChangeLog

@@ -1,14 +1,22 @@
-2011-04-05  Paul Eggert  <eggert@cs.ucla.edu>
+2011-04-06  Paul Eggert  <eggert@cs.ucla.edu>
 
 	* configure.in (ATTRIBUTE_FORMAT, ATTRIBUTE_FORMAT_PRINTF): New macros.
 
-2011-04-01  Paul Eggert  <eggert@cs.ucla.edu>
-
 	Replace 2 copies of readlink code with 1 gnulib version (Bug#8401).
 	* Makefile.in (GNULIB_MODULES): Add careadlinkat.
 	* lib/allocator.h, lib/careadlinkat.c, lib/careadlinkat.h:
 	* m4/ssize_t.m4: New files, automatically generated from gnulib.
 
+2011-04-06  Glenn Morris  <rgm@gnu.org>
+
+	* autogen/update_autogen: Handle loaddefs-like files as well.
+	(usage): Add -l, -C.
+	(clean, ldefs_flag, ldefs_in, ldefs_out): New variables.
+	With -l, check status of lisp/ as well.
+	With -C, clean before building.
+	(autoreconf): Only pass -f in the `clean' case.
+	(commit): New function.
+
 2011-03-28  Glenn Morris  <rgm@gnu.org>
 
 	* autogen/update_autogen: Pass -f to autoreconf.

autogen/update_autogen

@@ -25,6 +25,9 @@
 ## This is a helper script to update the pre-built generated files in
 ## the autogen/ directory.  This is suitable for running from cron.
 ## Only Emacs maintainers need use this, so it uses bash features.
+##
+## With the -l option, it also updates the versioned loaddefs-like
+## files in lisp/.  These include ldefs-boot, cl-loaddefs, rmail, etc.
 
 ### Code:
 
@@ -48,13 +51,17 @@ cd ../
 usage ()
 {
     cat 1>&2 <<EOF
-Usage: ${PN} [-f] [-c] [-q]
+Usage: ${PN} [-f] [-c] [-q] [-l [-L]] [-C] [-- make-flags]
 Update the generated files in the Emacs autogen/ directory.
 Options:
 -f: force an update even if the source files are locally modified.
 -c: if the update succeeds and the generated files are modified,
     commit them (caution).
 -q: be quiet; only give error messages, not status messages.
+-l: also update the versioned loaddefs-like files in lisp/.
+This requires a build.  Passes any non-option args to make (eg -- -j2).
+-L: also update ldefs-boot.el.
+-C: start from a clean state.  Slower, but more correct.
 EOF
     exit 1
 }
@@ -65,8 +72,13 @@ EOF
 force=
 commit=
 quiet=
+clean=
+ldefs_flag=
+lboot_flag=
 
 ## Parameters.
+ldefs_in=lisp/loaddefs.el
+ldefs_out=lisp/ldefs-boot.el
 sources="configure.in lib/Makefile.am"
 genfiles="configure aclocal.m4 src/config.in lib/Makefile.in compile config.guess config.sub depcomp install-sh missing"
 
@@ -81,7 +93,7 @@ tempfile=/tmp/$PN.$$
 trap "rm -f $tempfile 2> /dev/null" EXIT
 
 
-while getopts ":hcfq" option ; do
+while getopts ":hcflqCL" option ; do
     case $option in
         (h) usage ;;
 
@@ -89,8 +101,14 @@ while getopts ":hcfq" option ; do
 
         (f) force=1 ;;
 
+        (l) ldefs_flag=1 ;;
+
         (q) quiet=1 ;;
 
+        (C) clean=1 ;;
+
+        (L) lboot_flag=1 ;;
+
         (\?) die "Bad option -$OPTARG" ;;
 
         (:) die "Option -$OPTARG requires an argument" ;;
@@ -101,16 +119,17 @@ done
 shift $(( --OPTIND ))
 OPTIND=1
 
-[ $# -eq 0 ] || die "Wrong number of arguments"
-
 
+## Does not work 100% because a lot of Emacs batch output comes on stderr (?).
 [ "$quiet" ] && exec 1> /dev/null
 
 
 echo "Running bzr status..."
 
-bzr status -S $sources >| $tempfile || die "bzr status error for sources"
+bzr status -S $sources ${ldefs_flag:+lisp} >| $tempfile || \
+    die "bzr status error for sources"
 
+## The lisp portion could be more permissive, eg only care about .el files.
 while read stat file; do
 
     case $stat in
@@ -124,9 +143,21 @@ while read stat file; do
 done < $tempfile
 
 
+## Probably this is overkill, and there's no need to "bootstrap" just
+## for making autoloads.
+[ "$clean" ] && {
+
+    echo "Running 'make maintainer-clean'..."
+
+    make maintainer-clean #|| die "Cleaning error"
+
+    rm -f $ldefs_in
+}
+
+
 echo "Running autoreconf..."
 
-autoreconf -f -i -I m4 2>| $tempfile
+autoreconf ${clean:+-f} -i -I m4 2>| $tempfile
 
 retval=$?
 
@@ -162,27 +193,111 @@ while read stat file; do
 done < $tempfile
 
 
-[ "$modified" ] || {
-    echo "No files were modified"
-    exit 0
-}
-
-echo "Modified file(s): $modified"
-
-[ "$commit" ] || exit 0
-
-
-echo "Committing..."
-
-## bzr status output is annoyingly always relative to top-level, not PWD.
 cd ../
 
-bzr commit -m "Auto-commit of generated files." $modified || \
+
-    die "bzr commit error"
+## Uses global $commit.
+commit ()
+{
+    local type=$1
+    shift
+
+    [ $# -gt 0 ] || {
+        echo "No files were modified"
+        return 0
+    }
+
+    echo "Modified file(s): $@"
+
+    [ "$commit" ] || return 0
+
+    echo "Committing..."
+
+    ## bzr status output is always relative to top-level, not PWD.
+    bzr commit -m "Auto-commit of $type files." "$@" || return $?
+
+    echo "Committed files: $@"
+}                               # function commit
 
 
-echo "Committed files: $modified"
+commit "generated" $modified || die "bzr commit error"
 
-exit
+
+[ "$ldefs_flag" ] || exit 0
+
+
+echo "Finding loaddef targets..."
+
+sed -n -e '/^AUTOGEN_VCS/,/^$/ s/\\//p' lisp/Makefile.in | \
+    sed '/AUTOGEN_VCS/d' >| $tempfile || die "sed error"
+
+genfiles=
+
+while read genfile; do
+
+    [ -r lisp/$genfile ] || die "Unable to read $genfile"
+
+    genfiles="$genfiles $genfile"
+done < $tempfile
+
+
+[ "$genfiles" ] || die "Error setting genfiles"
+
+
+[ -e Makefile ] || {
+    echo "Running ./configure..."
+
+    ## Minimize required packages.
+    ./configure --without-x || die "configure error"
+}
+
+
+## Build the minimum needed to get the autoloads.
+echo "Running lib/ make..."
+
+make -C lib "$@" all || die "make lib error"
+
+
+echo "Running src/ make..."
+
+make -C src "$@" bootstrap-emacs || die "make src error"
+
+
+echo "Running lisp/ make..."
+
+make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs || die "make src error"
+
+
+[ ! "$lboot_flag" ] || cp $ldefs_in $ldefs_out || die "cp ldefs_boot error"
+
+
+cd lisp
+
+echo "Checking status of loaddef files..."
+
+## It probably would be fine to just check+commit lisp/, since
+## making autoloads should not effect any other files.  But better
+## safe than sorry.
+bzr status -S $genfiles ${ldefs_out#lisp/} >| $tempfile || \
+    die "bzr status error for generated files"
+
+
+modified=
+
+while read stat file; do
+
+    [ "$stat" != "M" ] && die "Unexpected status ($stat) for generated $file"
+    modified="$modified $file"
+
+done < $tempfile
+
+
+cd ../
+
+
+commit "loaddefs" $modified || die "bzr commit error"
+
+
+exit 0
 
 ### update_autogen ends here

lisp/ChangeLog

@@ -1,3 +1,41 @@
+2011-04-06  Glenn Morris  <rgm@gnu.org>
+
+	* Makefile.in (AUTOGEN_VCS): New variable.
+	(autoloads): Use $AUTOGEN_VCS.
+
+	* calendar/cal-move.el (calendar-scroll-toolkit-scroll): New function.
+	* calendar/calendar.el (calendar-mode-map):
+	Check for toolkit scroll bars.  (Bug#8305)
+
+2011-04-05  Chong Yidong  <cyd@stupidchicken.com>
+
+	* minibuffer.el (completion-in-region--postch)
+	(completion-in-region-mode): Remove unnecessary messages.
+
+2011-04-05  Juanma Barranquero  <lekktu@gmail.com>
+
+	* font-lock.el (font-lock-refresh-defaults):
+	Don't bind `hi-lock--inhibit-font-lock-hook', removed in
+	2010-10-09T04:09:19Z!cyd@stupidchicken.com and 2010-10-11T23:57:49Z!lekktu@gmail.com (2010-10-12).
+
+	* info.el (Info-directory-list, Info-read-node-name-2)
+	(Info-split-parameter-string): Doc fixes.
+	(Info-virtual-nodes): Reflow docstring.
+	(Info-find-file, Info-directory-toc-nodes, Info-history-toc-nodes)
+	(Info-apropos-toc-nodes, info-finder, Info-get-token)
+	(Info-find-emacs-command-nodes, Info-speedbar-key-map):
+	Fix typos in docstrings.
+	(Info-revert-buffer-function, Info-search, Info-isearch-pop-state)
+	(Info-speedbar-hierarchy-buttons, Info-speedbar-goto-node)
+	(Info-speedbar-buttons, Info-desktop-buffer-misc-data)
+	(Info-restore-desktop-buffer): Mark unused parameters.
+	(Info-directory-find-file, Info-directory-find-node)
+	(Info-history-find-file, Info-history-find-node, Info-toc-find-node)
+	(Info-virtual-index-find-node, Info-apropos-find-file)
+	(Info-apropos-find-node, Info-finder-find-file, Info-finder-find-node):
+	Mark unused parameters; fix typos in docstrings.
+	(Info-virtual-index): Remove unused local variable `nodename'.
+
 2011-04-05  Deniz Dogan  <deniz@dogan.se>
 
 	* net/rcirc.el: Update my e-mail address.

lisp/Makefile.in

@@ -70,6 +70,18 @@ AUTOGENEL = loaddefs.el \
 	cedet/ede/loaddefs.el \
 	cedet/srecode/loaddefs.el
 
+# Versioned files that are the value of someone's `generated-autoload-file'.
+# Note that update_loaddefs parses this.
+AUTOGEN_VCS = \
+	ps-print.el \
+	emulation/tpu-edt.el \
+	emacs-lisp/cl-loaddefs.el \
+	mail/rmail.el \
+	dired.el \
+	ibuffer.el \
+	htmlfontify.el \
+	emacs-lisp/eieio.el
+
 # Value of max-lisp-eval-depth when compiling initially.
 # During bootstrapping the byte-compiler is run interpreted when compiling
 # itself, and uses more stack than usual.
@@ -153,13 +165,9 @@ finder-data: doit
 	echo Directories: $$wins; \
 	$(emacs) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins
 
-# The chmod +w is to handle env var CVSREAD=1.  Files named
+# The chmod +w is to handle env var CVSREAD=1.
-# are identified by being the value of `generated-autoload-file'.
 autoloads: $(LOADDEFS) doit
-	chmod +w $(lisp)/ps-print.el $(lisp)/emulation/tpu-edt.el \
+	cd $(lisp) && chmod +w $(AUTOGEN_VCS)
-	  $(lisp)/emacs-lisp/cl-loaddefs.el $(lisp)/mail/rmail.el \
-	  $(lisp)/dired.el $(lisp)/ibuffer.el $(lisp)/htmlfontify.el \
-	  $(lisp)/emacs-lisp/eieio.el
 	cd $(lisp); $(setwins_almost); \
 	echo Directories: $$wins; \
 	$(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins

lisp/calendar/cal-move.el

@@ -204,6 +204,18 @@ EVENT is an event like `last-nonmenu-event'."
 (define-obsolete-function-alias 'scroll-calendar-left-three-months
   'calendar-scroll-left-three-months "23.1")
 
+;; cf scroll-bar-toolkit-scroll
+;;;###cal-autoload
+(defun calendar-scroll-toolkit-scroll (event)
+  "Function to scroll the calendar after a toolkit scroll-bar click."
+  (interactive "e")
+  (let ((part (nth 4 (event-end event))))
+    ;; Not bothering with drag events (handle, end-scroll).
+    (cond ((memq part '(above-handle up top))
+           (calendar-scroll-right nil event))
+          ((memq part '(below-handle down bottom))
+           (calendar-scroll-left nil event)))))
+
 ;;;###cal-autoload
 (defun calendar-scroll-right-three-months (arg &optional event)
   "Scroll the displayed calendar window right by 3*ARG months.

lisp/calendar/calendar.el

@@ -1648,14 +1648,17 @@ line."
     (define-key map [down-mouse-2]
       (easy-menu-binding cal-menu-global-mouse-menu))
 
-    ;; Left-click moves us forward in time, right-click backwards.
     ;; cf scroll-bar.el.
-    (define-key map [vertical-scroll-bar mouse-1] 'calendar-scroll-left)
+    (if (and (boundp 'x-toolkit-scroll-bars) x-toolkit-scroll-bars)
-    (define-key map [vertical-scroll-bar drag-mouse-1] 'calendar-scroll-left)
+        (define-key map [vertical-scroll-bar mouse-1]
-    ;; down-mouse-2 stays as scroll-bar-drag.
+          'calendar-scroll-toolkit-scroll)
-    (define-key map [vertical-scroll-bar mouse-3] 'calendar-scroll-right)
+      ;; Left-click moves us forward in time, right-click backwards.
-    (define-key map [vertical-scroll-bar drag-mouse-3] 'calendar-scroll-right)
+      (define-key map [vertical-scroll-bar mouse-1] 'calendar-scroll-left)
-
+      (define-key map [vertical-scroll-bar drag-mouse-1] 'calendar-scroll-left)
+      ;; down-mouse-2 stays as scroll-bar-drag.
+      (define-key map [vertical-scroll-bar mouse-3] 'calendar-scroll-right)
+      (define-key map [vertical-scroll-bar drag-mouse-3]
+        'calendar-scroll-right))
     map)
   "Keymap for `calendar-mode'.")
 

lisp/font-lock.el

@@ -1765,8 +1765,7 @@ variables directly.
 Note: This function will erase modifications done by
 `font-lock-add-keywords' or `font-lock-remove-keywords', but will
 preserve `hi-lock-mode' highlighting patterns."
-  (let ((hi-lock--inhibit-font-lock-hook t))
+  (font-lock-mode -1)
-    (font-lock-mode -1))
   (kill-local-variable 'font-lock-set-defaults)
   (font-lock-mode 1))
 

lisp/gnus/ChangeLog

@@ -1,3 +1,35 @@
+2011-04-05  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnus-registry.el (gnus-registry-fixup-registry): New function to
+	fixup the parameters that can be customized by the user between
+	save/read cycles.
+	(gnus-registry-read): Use it.
+	(gnus-registry-make-db): Use it.
+	(gnus-registry-spool-action, gnus-registry-handle-action): Fix
+	messaging.
+	(gnus-registry--split-fancy-with-parent-internal): Fix loop.  Map
+	references to actual group names with sender and subject tracking.
+	(gnus-registry-post-process-groups): Use `cond' for better messaging.
+	(gnus-registry-usage-test): Add subject lookup test.
+
+	* registry.el (registry-db, initialize-instance): Set up constructor
+	instead of :initform arguments for the sake of older Emacsen.
+	(registry-lookup-breaks-before-lexbind): New method to demonstrate
+	pre-lexbind merge bug.
+	(registry-usage-test): Use it.
+	(initialize-instance, registry-db): Move the non-function initforms
+	back to the class definition.
+
+2011-04-03  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* registry.el: New library to manage gnus-registry-style data.
+
+	* gnus-registry.el: Use it (major rewrite).
+
+	* nnregistry.el: Use it.
+
+	* spam.el: Use it.
+
 2011-04-03  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* gnus-sum.el (gnus-update-marks): Reinstate the code to not alter

lisp/gnus/nnregistry.el

@@ -53,7 +53,7 @@
 (deffoo nnregistry-request-article (id &optional group server buffer)
   (and (not nnregistry-within-nnregistry)
        (let* ((nnregistry-within-nnregistry t)
-	      (group (gnus-registry-fetch-group id))
+	      (group (nth 0 (gnus-registry-get-id-key id 'group)))
 	      (gnus-override-method nil))
 	 (message "nnregistry: requesting article `%s' in group `%s'"
 		  id group)

lisp/gnus/registry.el

@@ -0,0 +1,411 @@
+;;; registry.el --- Track and remember data items by various fields
+
+;; Copyright (C) 2011  Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Keywords: data
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides a general-purpose EIEIO-based registry
+;; database with persistence, initialized with these fields:
+
+;; version: a float, 0.1 currently (don't change it)
+
+;; max-hard: an integer, default 5000000
+
+;; max-soft: an integer, default 50000
+
+;; precious: a list of symbols
+
+;; tracked: a list of symbols
+
+;; tracker: a hashtable tuned for 100 symbols to track (you should
+;; only access this with the :lookup2-function and the
+;; :lookup2+-function)
+
+;; data: a hashtable with default size 10K and resize threshold 2.0
+;; (this reflects the expected usage so override it if you know better)
+
+;; ...plus methods to do all the work: `registry-search',
+;; `registry-lookup', `registry-lookup-secondary',
+;; `registry-lookup-secondary-value', `registry-insert',
+;; `registry-delete', `registry-prune', `registry-size' which see
+
+;; and with the following properties:
+
+;; Every piece of data has a unique ID and some general-purpose fields
+;; (F1=D1, F2=D2, F3=(a b c)...) expressed as an alist, e.g.
+
+;; ((F1 D1) (F2 D2) (F3 a b c))
+
+;; Note that whether a field has one or many pieces of data, the data
+;; is always a list of values.
+
+;; The user decides which fields are "precious", F2 for example.  At
+;; PRUNE TIME (when the :prune-function is called), the registry will
+;; trim any entries without the F2 field until the size is :max-soft
+;; or less.  No entries with the F2 field will be removed at PRUNE
+;; TIME.
+
+;; When an entry is inserted, the registry will reject new entries
+;; if they bring it over the max-hard limit, even if they have the F2
+;; field.
+
+;; The user decides which fields are "tracked", F1 for example.  Any
+;; new entry is then indexed by all the tracked fields so it can be
+;; quickly looked up that way.  The data is always a list (see example
+;; above) and each list element is indexed.
+
+;; Precious and tracked field names must be symbols.  All other
+;; fields can be any other Emacs Lisp types.
+
+;;; Code:
+
+(eval-when-compile (require 'ert))
+(eval-when-compile (require 'cl))
+(eval-and-compile
+  (or (ignore-errors (progn
+                       (require 'eieio)
+                       (require 'eieio-base)))
+      ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
+      (ignore-errors
+        (let ((load-path (cons (expand-file-name
+                                "gnus-fallback-lib/eieio"
+                                (file-name-directory (locate-library "gnus")))
+                               load-path)))
+          (require 'eieio)
+          (require 'eieio-base)))
+      (error
+       "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
+
+(defclass registry-db (eieio-persistent)
+  ((version :initarg :version
+            :initform 0.1
+            :type float
+            :custom float
+            :documentation "The registry version.")
+   (max-hard :initarg :max-hard
+             :initform 5000000
+             :type integer
+             :custom integer
+             :documentation "Never accept more than this many elements.")
+   (max-soft :initarg :max-soft
+             :initform 50000
+             :type integer
+             :custom integer
+             :documentation "Prune as much as possible to get to this size.")
+   (tracked :initarg :tracked
+            :initform nil
+            :type t
+            :documentation "The tracked (indexed) fields, a list of symbols.")
+   (precious :initarg :precious
+             :initform nil
+             :type t
+             :documentation "The precious fields, a list of symbols.")
+   (tracker :initarg :tracker
+            :type hash-table
+            :documentation "The field tracking hashtable.")
+   (data :initarg :data
+         :type hash-table
+         :documentation "The data hashtable.")))
+
+(defmethod initialize-instance :after ((this registry-db) slots)
+  "Set value of data slot of THIS after initialization."
+  (with-slots (data tracker) this
+    (unless (member :data slots)
+      (setq data (make-hash-table :size 10000 :rehash-size 2.0 :test 'equal)))
+    (unless (member :tracker slots)
+      (setq tracker (make-hash-table :size 100 :rehash-size 2.0)))))
+
+(defmethod registry-lookup ((db registry-db) keys)
+  "Search for KEYS in the registry-db THIS.
+Returns a alist of the key followed by the entry in a list, not a cons cell."
+  (let ((data (oref db :data)))
+    (delq nil
+          (mapcar
+           (lambda (k)
+             (when (gethash k data)
+               (list k (gethash k data))))
+           keys))))
+
+(defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys)
+  "Search for KEYS in the registry-db THIS.
+Returns a alist of the key followed by the entry in a list, not a cons cell."
+  (let ((data (oref db :data)))
+    (delq nil
+          (loop for key in keys
+                when (gethash key data)
+                collect (list key (gethash key data))))))
+
+(defmethod registry-lookup-secondary ((db registry-db) tracksym
+                                      &optional create)
+  "Search for TRACKSYM in the registry-db THIS.
+When CREATE is not nil, create the secondary index hashtable if needed."
+  (let ((h (gethash tracksym (oref db :tracker))))
+    (if h
+        h
+      (when create
+        (puthash tracksym
+                 (make-hash-table :size 800 :rehash-size 2.0 :test 'equal)
+                 (oref db :tracker))
+        (gethash tracksym (oref db :tracker))))))
+
+(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val
+                                            &optional set)
+  "Search for TRACKSYM with value VAL in the registry-db THIS.
+When SET is not nil, set it for VAL (use t for an empty list)."
+  ;; either we're asked for creation or there should be an existing index
+  (when (or set (registry-lookup-secondary db tracksym))
+    ;; set the entry if requested,
+    (when set
+      (puthash val (if (eq t set) '() set)
+               (registry-lookup-secondary db tracksym t)))
+    (gethash val (registry-lookup-secondary db tracksym))))
+
+(defun registry--match (mode entry check-list)
+  ;; for all members
+  (when check-list
+    (let ((key (nth 0 (nth 0 check-list)))
+          (vals (cdr-safe (nth 0 check-list)))
+          found)
+      (while (and key vals (not found))
+        (setq found (case mode
+                      (:member
+                       (member (car-safe vals) (cdr-safe (assoc key entry))))
+                      (:regex
+                       (string-match (car vals)
+                                     (mapconcat
+                                      'prin1-to-string
+                                      (cdr-safe (assoc key entry))
+                                      "\0"))))
+              vals (cdr-safe vals)))
+      (or found
+          (registry--match mode entry (cdr-safe check-list))))))
+
+(defmethod registry-search ((db registry-db) &rest spec)
+  "Search for SPEC across the registry-db THIS.
+For example calling with :member '(a 1 2) will match entry '((a 3 1)).
+Calling with :all t (any non-nil value) will match all.
+Calling with :regex '\(a \"h.llo\") will match entry '((a \"hullo\" \"bye\").
+The test order is to check :all first, then :member, then :regex."
+  (when db
+    (let ((all (plist-get spec :all))
+          (member (plist-get spec :member))
+          (regex (plist-get spec :regex)))
+      (loop for k being the hash-keys of (oref db :data) using (hash-values v)
+            when (or
+                  ;; :all non-nil returns all
+                  all
+                  ;; member matching
+                  (and member (registry--match :member v member))
+                  ;; regex matching
+                  (and regex (registry--match :regex v regex)))
+            collect k))))
+
+(defmethod registry-delete ((db registry-db) keys assert &rest spec)
+  "Delete KEYS from the registry-db THIS.
+If KEYS is nil, use SPEC to do a search.
+Updates the secondary ('tracked') indices as well.
+With assert non-nil, errors out if the key does not exist already."
+  (let* ((data (oref db :data))
+         (keys (or keys
+                   (apply 'registry-search db spec)))
+         (tracked (oref db :tracked)))
+
+    (dolist (key keys)
+      (let ((entry (gethash key data)))
+        (when assert
+          (assert entry nil
+                  "Key %s does not exists in database" key))
+        ;; clean entry from the secondary indices
+        (dolist (tr tracked)
+          ;; is this tracked symbol indexed?
+          (when (registry-lookup-secondary db tr)
+            ;; for every value in the entry under that key...
+            (dolist (val (cdr-safe (assq tr entry)))
+              (let* ((value-keys (registry-lookup-secondary-value db tr val)))
+              (when (member key value-keys)
+                ;; override the previous value
+                (registry-lookup-secondary-value
+                 db tr val
+                 ;; with the indexed keys MINUS the current key
+                 ;; (we pass t when the list is empty)
+                 (or (delete key value-keys) t)))))))
+        (remhash key data)))
+    keys))
+
+(defmethod registry-insert ((db registry-db) key entry)
+  "Insert ENTRY under KEY into the registry-db THIS.
+Updates the secondary ('tracked') indices as well.
+Errors out if the key exists already."
+
+  (assert (not (gethash key (oref db :data))) nil
+          "Key already exists in database")
+
+  (assert (< (registry-size db)
+             (oref db :max-hard))
+          nil
+          "max-hard size limit reached")
+
+  ;; store the entry
+  (puthash key entry (oref db :data))
+
+  ;; store the secondary indices
+  (dolist (tr (oref db :tracked))
+    ;; for every value in the entry under that key...
+    (dolist (val (cdr-safe (assq tr entry)))
+      (let* ((value-keys (registry-lookup-secondary-value db tr val)))
+        (pushnew key value-keys :test 'equal)
+        (registry-lookup-secondary-value db tr val value-keys))))
+  entry)
+
+(defmethod registry-size ((db registry-db))
+  "Returns the size of the registry-db object THIS.
+This is the key count of the :data slot."
+  (hash-table-count (oref db :data)))
+
+(defmethod registry-prune ((db registry-db))
+  "Prunes the registry-db object THIS.
+Removes only entries without the :precious keys."
+  (let* ((precious (oref db :precious))
+         (precious-p (lambda (entry-key) (cdr (memq (car entry-key) precious))))
+         (data (oref db :data))
+         (limit (oref db :max-soft))
+         (size (registry-size db))
+         (candidates (loop for k being the hash-keys of data
+                           using (hash-values v)
+                           when (notany precious-p v)
+                           collect k))
+         (candidates-count (length candidates))
+         ;; are we over max-soft?
+         (prune-needed (> size limit)))
+
+    ;; while we have more candidates than we need to remove...
+    (while (and (> candidates-count (- size limit)) candidates)
+      (decf candidates-count)
+      (setq candidates (cdr candidates)))
+
+    (registry-delete db candidates nil)))
+
+(ert-deftest registry-instantiation-test ()
+  (should (registry-db "Testing")))
+
+(ert-deftest registry-match-test ()
+  (let ((entry '((hello "goodbye" "bye") (blank))))
+
+    (message "Testing :regex matching")
+    (should (registry--match :regex entry '((hello "nye" "bye"))))
+    (should (registry--match :regex entry '((hello "good"))))
+    (should-not (registry--match :regex entry '((hello "nye"))))
+    (should-not (registry--match :regex entry '((hello))))
+
+    (message "Testing :member matching")
+    (should (registry--match :member entry '((hello "bye"))))
+    (should (registry--match :member entry '((hello "goodbye"))))
+    (should-not (registry--match :member entry '((hello "good"))))
+    (should-not (registry--match :member entry '((hello "nye"))))
+    (should-not (registry--match :member entry '((hello)))))
+  (message "Done with matching testing."))
+
+(defun registry-make-testable-db (n &optional name file)
+  (let* ((db (registry-db
+              (or name "Testing")
+              :file (or file "unused")
+              :max-hard n
+              :max-soft 0               ; keep nothing not precious
+              :precious '(extra more-extra)
+              :tracked '(sender subject groups))))
+    (dotimes (i n)
+      (registry-insert db i `((sender "me")
+                              (subject "about you")
+                              (more-extra) ; empty data key should be pruned
+                              ;; first 5 entries will NOT have this extra data
+                              ,@(when (< 5 i) (list (list 'extra "more data")))
+                              (groups ,(number-to-string i)))))
+    db))
+
+(ert-deftest registry-usage-test ()
+  (let* ((n 100)
+         (db (registry-make-testable-db n)))
+    (message "size %d" n)
+    (should (= n (registry-size db)))
+    (message "max-hard test")
+    (should-error (registry-insert db "new" '()))
+    (message "Individual lookup")
+    (should (= 58 (caadr (registry-lookup db '(1 58 99)))))
+    (message "Grouped individual lookup")
+    (should (= 3 (length (registry-lookup db '(1 58 99)))))
+    (message "Individual lookup (breaks before lexbind)")
+    (should (= 58
+               (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)))))
+    (message "Search")
+    (should (= n (length (registry-search db :all t))))
+    (should (= n (length (registry-search db :member '((sender "me"))))))
+    (message "Secondary index search")
+    (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
+    (should (equal '(74) (registry-lookup-secondary-value db 'groups "74")))
+    (message "Delete")
+    (should (registry-delete db '(1) t))
+    (decf n)
+    (message "Search after delete")
+    (should (= n (length (registry-search db :all t))))
+    (message "Secondary search after delete")
+    (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
+    (message "Pruning")
+    (let* ((tokeep (registry-search db :member '((extra "more data"))))
+           (count (- n (length tokeep)))
+           (pruned (registry-prune db))
+           (prune-count (length pruned)))
+      (message "Expecting to prune %d entries and pruned %d"
+               count prune-count)
+      (should (and (= count 5)
+                   (= count prune-count))))
+    (message "Done with usage testing.")))
+
+(ert-deftest registry-persistence-test ()
+  (let* ((n 100)
+         (tempfile (make-temp-file "registry-persistence-"))
+         (name "persistence tester")
+         (db (registry-make-testable-db n name tempfile))
+         size back)
+    (message "Saving to %s" tempfile)
+    (eieio-persistent-save db)
+    (setq size (nth 7 (file-attributes tempfile)))
+    (message "Saved to %s: size %d" tempfile size)
+    (should (< 0 size))
+    (with-temp-buffer
+      (insert-file-contents-literally tempfile)
+      (should (looking-at (concat ";; Object "
+                                  name
+                                  "\n;; EIEIO PERSISTENT OBJECT"))))
+    (message "Reading object back")
+    (setq back (eieio-persistent-read tempfile))
+    (should back)
+    (message "Read object back: %d keys, expected %d==%d"
+             (registry-size back) n (registry-size db))
+    (should (= (registry-size back) n))
+    (should (= (registry-size back) (registry-size db)))
+    (delete-file tempfile))
+  (message "Done with persistence testing."))
+
+(provide 'registry)
+;;; registry.el ends here

lisp/gnus/spam.el

@@ -68,9 +68,9 @@
 
 ;; autoload gnus-registry
 (autoload 'gnus-registry-group-count "gnus-registry")
-(autoload 'gnus-registry-add-group "gnus-registry")
+(autoload 'gnus-registry-get-id-key "gnus-registry")
-(autoload 'gnus-registry-store-extra-entry "gnus-registry")
+(autoload 'gnus-registry-set-id-key "gnus-registry")
-(autoload 'gnus-registry-fetch-extra "gnus-registry")
+(autoload 'gnus-registry-handle-action "gnus-registry")
 
 ;; autoload dns-query
 (autoload 'dns-query "dns")
@@ -1764,8 +1764,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
              (when (and id split-return spam-log-to-registry)
                (when (zerop (gnus-registry-group-count id))
-                 (gnus-registry-add-group
+                 (gnus-registry-handle-action id nil group subject sender))
-                  id group subject sender))
 
                (unless registry-lookup
                  (spam-log-processing-to-registry
@@ -1894,13 +1893,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
              (spam-process-type-valid-p type)
              (spam-classification-valid-p classification)
              (spam-backend-valid-p backend))
-        (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
+        (let ((cell-list (gnus-registry-get-id-key id type))
               (cell (list classification backend group)))
           (push cell cell-list)
-          (gnus-registry-store-extra-entry
+          (gnus-registry-set-id-key id type cell-list))
-           id
-           type
-           cell-list))
 
       (gnus-error
        7
@@ -1913,7 +1909,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
   (when spam-log-to-registry
     (if (and (stringp id)
              (spam-process-type-valid-p type))
-        (cdr-safe (gnus-registry-fetch-extra id type))
+        (gnus-registry-get-id-key id type)
       (progn
         (gnus-error
          7
@@ -1945,7 +1941,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
              (spam-process-type-valid-p type)
              (spam-classification-valid-p classification)
              (spam-backend-valid-p backend))
-        (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
+        (let ((cell-list (gnus-registry-get-id-key id type))
               found)
           (dolist (cell cell-list)
             (unless found
@@ -1970,16 +1966,13 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
              (spam-process-type-valid-p type)
              (spam-classification-valid-p classification)
              (spam-backend-valid-p backend))
-        (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
+        (let ((cell-list (gnus-registry-get-id-key id type))
               new-cell-list found)
           (dolist (cell cell-list)
             (unless (and (eq classification (nth 0 cell))
                          (eq backend (nth 1 cell)))
               (push cell new-cell-list)))
-          (gnus-registry-store-extra-entry
+          (gnus-registry-set-id-key id type new-cell-list))
-           id
-           type
-           new-cell-list))
       (progn
         (gnus-error 7 (format
                        "%s call with bad ID, type, spam-backend, or group"

lisp/info.el

@@ -165,7 +165,7 @@ A header-line does not scroll with the rest of the buffer."
 If nil, meaning not yet initialized, Info uses the environment
 variable INFOPATH to initialize it, or `Info-default-directory-list'
 if there is no INFOPATH variable in the environment, or the
-concatenation of the two if INFOPATH ends with a colon.
+concatenation of the two if INFOPATH ends with a `path-separator'.
 
 When `Info-directory-list' is initialized from the value of
 `Info-default-directory-list', and Emacs is installed in one of the
@@ -343,9 +343,8 @@ Each element of the list has the format (NODENAME (OPERATION . HANDLER) ...)
 where NODENAME is a regexp that matches a class of virtual Info node names.
 It should be carefully chosen to not cause node name clashes with
 existing node names.  OPERATION is one of the following operation
-symbols `find-node' that define what HANDLER
+symbols `find-node' that define what HANDLER function to call instead
-function to call instead of calling the default corresponding function
+of calling the default corresponding function to override it.")
-to override it.")
 
 (defvar Info-current-node-virtual nil
   "Non-nil if the current Info node is virtual.")
@@ -379,50 +378,50 @@ or `Info-virtual-nodes'."
   ;; The MS-DOS list should work both when long file names are
   ;; supported (Windows 9X), and when only 8+3 file names are available.
   (if (eq system-type 'ms-dos)
-      '( (".gz"      . "gunzip")
+      '( (".gz"       . "gunzip")
-	 (".z"       . "gunzip")
+	 (".z"        . "gunzip")
-	 (".bz2"     . ("bzip2" "-dc"))
+	 (".bz2"      . ("bzip2" "-dc"))
-	 (".inz"     . "gunzip")
+	 (".inz"      . "gunzip")
-	 (".igz"     . "gunzip")
+	 (".igz"      . "gunzip")
-	 (".info.Z"  . "gunzip")
+	 (".info.Z"   . "gunzip")
-	 (".info.gz" . "gunzip")
+	 (".info.gz"  . "gunzip")
-	 ("-info.Z"  . "gunzip")
+	 ("-info.Z"   . "gunzip")
-	 ("-info.gz" . "gunzip")
+	 ("-info.gz"  . "gunzip")
-	 ("/index.gz". "gunzip")
+	 ("/index.gz" . "gunzip")
-	 ("/index.z" . "gunzip")
+	 ("/index.z"  . "gunzip")
-	 (".inf"     . nil)
+	 (".inf"      . nil)
-	 (".info"    . nil)
+	 (".info"     . nil)
-	 ("-info"    . nil)
+	 ("-info"     . nil)
-	 ("/index"   . nil)
+	 ("/index"    . nil)
-	 (""         . nil))
+	 (""          . nil))
-    '( (".info.Z".    "uncompress")
+    '( (".info.Z"    . "uncompress")
-       (".info.Y".    "unyabba")
+       (".info.Y"    . "unyabba")
-       (".info.gz".   "gunzip")
+       (".info.gz"   . "gunzip")
-       (".info.z".    "gunzip")
+       (".info.z"    . "gunzip")
-       (".info.bz2" . ("bzip2" "-dc"))
+       (".info.bz2"  . ("bzip2" "-dc"))
-       (".info.xz".   "unxz")
+       (".info.xz"   . "unxz")
-       (".info".      nil)
+       (".info"      . nil)
-       ("-info.Z".   "uncompress")
+       ("-info.Z"    . "uncompress")
-       ("-info.Y".   "unyabba")
+       ("-info.Y"    . "unyabba")
-       ("-info.gz".  "gunzip")
+       ("-info.gz"   . "gunzip")
-       ("-info.bz2" . ("bzip2" "-dc"))
+       ("-info.bz2"  . ("bzip2" "-dc"))
-       ("-info.z".   "gunzip")
+       ("-info.z"    . "gunzip")
-       ("-info.xz".  "unxz")
+       ("-info.xz"   . "unxz")
-       ("-info".     nil)
+       ("-info"      . nil)
-       ("/index.Z".   "uncompress")
+       ("/index.Z"   . "uncompress")
-       ("/index.Y".   "unyabba")
+       ("/index.Y"   . "unyabba")
-       ("/index.gz".  "gunzip")
+       ("/index.gz"  . "gunzip")
-       ("/index.z".   "gunzip")
+       ("/index.z"   . "gunzip")
-       ("/index.bz2". ("bzip2" "-dc"))
+       ("/index.bz2" . ("bzip2" "-dc"))
-       ("/index.xz".  "unxz")
+       ("/index.xz"  . "unxz")
-       ("/index".     nil)
+       ("/index"     . nil)
-       (".Z".         "uncompress")
+       (".Z"         . "uncompress")
-       (".Y".         "unyabba")
+       (".Y"         . "unyabba")
-       (".gz".        "gunzip")
+       (".gz"        . "gunzip")
-       (".z".         "gunzip")
+       (".z"         . "gunzip")
-       (".bz2" .      ("bzip2" "-dc"))
+       (".bz2"       . ("bzip2" "-dc"))
-       (".xz".        "unxz")
+       (".xz"        . "unxz")
-       ("".           nil)))
+       (""           . nil)))
   "List of file name suffixes and associated decoding commands.
 Each entry should be (SUFFIX . STRING); the file is given to
 the command as standard input.
@@ -705,7 +704,7 @@ In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself."
 	 (re-search-backward regexp beg t))))
 
 (defun Info-find-file (filename &optional noerror)
-  "Return expanded FILENAME, or t, if FILENAME is \"dir\".
+  "Return expanded FILENAME, or t if FILENAME is \"dir\".
 Optional second argument NOERROR, if t, means if file is not found
 just return nil (no error)."
   ;; Convert filename to lower case if not found as specified.
@@ -835,7 +834,7 @@ is preserved, if possible."
       (if new-history
 	  (setq Info-history (cons new-history Info-history))))))
 
-(defun Info-revert-buffer-function (ignore-auto noconfirm)
+(defun Info-revert-buffer-function (_ignore-auto noconfirm)
   (when (or noconfirm (y-or-n-p "Revert info buffer? "))
     (Info-revert-find-node Info-current-file Info-current-node)
     (message "Reverted %s" Info-current-file)))
@@ -1394,10 +1393,11 @@ a case-insensitive match is tried."
 ;;   \0\h[image param=value ...\h\0]
 ;; into the Info file for handling images.
 (defun Info-split-parameter-string (parameter-string)
-  "Return alist of (\"KEY\" . \"VALUE\") from PARAMETER-STRING; a
+  "Return alist of (\"KEY\" . \"VALUE\") from PARAMETER-STRING.
-whitespace separated list of KEY=VALUE pairs.  If VALUE contains
+PARAMETER-STRING is a whitespace separated list of KEY=VALUE pairs.
-whitespace or double quotes, it must be quoted in double quotes and
+If VALUE contains whitespace or double quotes, it must be quoted
-any double quotes or backslashes must be escaped (\\\",\\\\)."
+in double quotes and any double quotes or backslashes must be
+escaped (\\\",\\\\)."
   (let ((start 0)
 	(parameter-alist))
     (while (string-match
@@ -1572,8 +1572,7 @@ If FORK is a string, it is the name to use for the new buffer."
 (defvar Info-read-node-completion-table)
 
 (defun Info-read-node-name-2 (dirs suffixes string pred action)
-  "Virtual completion table for file names input in Info node names.
+  "Virtual completion table for file names input in Info node names."
-PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
   (setq suffixes (remove "" suffixes))
   (when (file-name-absolute-p string)
     (setq dirs (list (file-name-directory string))))
@@ -1694,7 +1693,7 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
 (defvar Info-search-case-fold nil
   "The value of `case-fold-search' from previous `Info-search' command.")
 
-(defun Info-search (regexp &optional bound noerror count direction)
+(defun Info-search (regexp &optional bound _noerror _count direction)
   "Search for REGEXP, starting from point, and select node it's found in.
 If DIRECTION is `backward', search in the reverse direction."
   (interactive (list (read-string
@@ -1915,7 +1914,7 @@ If DIRECTION is `backward', search in the reverse direction."
   `(lambda (cmd)
      (Info-isearch-pop-state cmd ',Info-current-file ',Info-current-node)))
 
-(defun Info-isearch-pop-state (cmd file node)
+(defun Info-isearch-pop-state (_cmd file node)
   (or (and (equal Info-current-file file)
            (equal Info-current-node node))
       (progn (Info-find-node file node) (sit-for 0))))
@@ -2093,16 +2092,16 @@ If SAME-FILE is non-nil, do not move to a different Info file."
 	       ))
 
 (defun Info-directory-toc-nodes (filename)
-  "Directory-specific implementation of Info-directory-toc-nodes."
+  "Directory-specific implementation of `Info-directory-toc-nodes'."
   `(,filename
     ("Top" nil nil nil)))
 
-(defun Info-directory-find-file (filename &optional noerror)
+(defun Info-directory-find-file (filename &optional _noerror)
-  "Directory-specific implementation of Info-find-file."
+  "Directory-specific implementation of `Info-find-file'."
   filename)
 
-(defun Info-directory-find-node (filename nodename &optional no-going-back)
+(defun Info-directory-find-node (_filename _nodename &optional _no-going-back)
-  "Directory-specific implementation of Info-find-node-2."
+  "Directory-specific implementation of `Info-find-node-2'."
   (Info-insert-dir))
 
 ;;;###autoload
@@ -2119,16 +2118,16 @@ If SAME-FILE is non-nil, do not move to a different Info file."
 	       ))
 
 (defun Info-history-toc-nodes (filename)
-  "History-specific implementation of Info-history-toc-nodes."
+  "History-specific implementation of `Info-history-toc-nodes'."
   `(,filename
     ("Top" nil nil nil)))
 
-(defun Info-history-find-file (filename &optional noerror)
+(defun Info-history-find-file (filename &optional _noerror)
-  "History-specific implementation of Info-find-file."
+  "History-specific implementation of `Info-find-file'."
   filename)
 
-(defun Info-history-find-node (filename nodename &optional no-going-back)
+(defun Info-history-find-node (filename nodename &optional _no-going-back)
-  "History-specific implementation of Info-find-node-2."
+  "History-specific implementation of `Info-find-node-2'."
   (insert (format "\n\^_\nFile: %s,  Node: %s,  Up: (dir)\n\n"
 		  (or filename Info-current-file) nodename))
   (insert "Recently Visited Nodes\n")
@@ -2157,8 +2156,8 @@ If SAME-FILE is non-nil, do not move to a different Info file."
 	       (find-node . Info-toc-find-node)
 	       ))
 
-(defun Info-toc-find-node (filename nodename &optional no-going-back)
+(defun Info-toc-find-node (filename nodename &optional _no-going-back)
-  "Toc-specific implementation of Info-find-node-2."
+  "Toc-specific implementation of `Info-find-node-2'."
   (let* ((curr-file (substring-no-properties (or filename Info-current-file)))
 	 (curr-node (substring-no-properties (or nodename Info-current-node)))
 	 (node-list (Info-toc-nodes curr-file)))
@@ -3138,8 +3137,8 @@ FILENAME is the file name of the manual,
 TOPIC is the search string given as an argument to `Info-virtual-index',
 MATCHES is a list of index matches found by `Info-index'.")
 
-(defun Info-virtual-index-find-node (filename nodename &optional no-going-back)
+(defun Info-virtual-index-find-node (filename nodename &optional _no-going-back)
-  "Index-specific implementation of Info-find-node-2."
+  "Index-specific implementation of `Info-find-node-2'."
   ;; Generate Index-like menu of matches
   (if (string-match "^\\*Index for `\\(.+\\)'\\*$" nodename)
       ;; Generate Index-like menu of matches
@@ -3201,8 +3200,7 @@ search results."
       (Info-find-node Info-current-file "*Index*")
     (unless (assoc (cons Info-current-file topic) Info-virtual-index-nodes)
       (let ((orignode Info-current-node)
-	    (ohist-list Info-history-list)
+	    (ohist-list Info-history-list))
-	    nodename)
 	;; Reuse `Info-index' to set `Info-index-alternatives'.
 	(Info-index topic)
 	(push (cons (cons Info-current-file topic) Info-index-alternatives)
@@ -3232,18 +3230,18 @@ STRING is the search string given as an argument to `info-apropos',
 MATCHES is a list of index matches found by `Info-apropos-matches'.")
 
 (defun Info-apropos-toc-nodes (filename)
-  "Apropos-specific implementation of Info-apropos-toc-nodes."
+  "Apropos-specific implementation of `Info-apropos-toc-nodes'."
   (let ((nodes (mapcar 'car (reverse Info-apropos-nodes))))
     `(,filename
       ("Top" nil nil ,nodes)
       ,@(mapcar (lambda (node) `(,node "Top" nil nil)) nodes))))
 
-(defun Info-apropos-find-file (filename &optional noerror)
+(defun Info-apropos-find-file (filename &optional _noerror)
-  "Apropos-specific implementation of Info-find-file."
+  "Apropos-specific implementation of `Info-find-file'."
   filename)
 
-(defun Info-apropos-find-node (filename nodename &optional no-going-back)
+(defun Info-apropos-find-node (_filename nodename &optional _no-going-back)
-  "Apropos-specific implementation of Info-find-node-2."
+  "Apropos-specific implementation of `Info-find-node-2'."
   (if (equal nodename "Top")
       ;; Generate Top menu
       (let ((nodes (reverse Info-apropos-nodes)))
@@ -3362,8 +3360,8 @@ Build a menu of the possible matches."
 (defvar Info-finder-file "*Finder*"
   "Info file name of the virtual Info keyword finder manual.")
 
-(defun Info-finder-find-file (filename &optional noerror)
+(defun Info-finder-find-file (filename &optional _noerror)
-  "Finder-specific implementation of Info-find-file."
+  "Finder-specific implementation of `Info-find-file'."
   filename)
 
 (defvar finder-known-keywords)
@@ -3373,8 +3371,8 @@ Build a menu of the possible matches."
 (defvar finder-keywords-hash)
 (defvar package-alist)                  ; finder requires package
 
-(defun Info-finder-find-node (filename nodename &optional no-going-back)
+(defun Info-finder-find-node (_filename nodename &optional _no-going-back)
-  "Finder-specific implementation of Info-find-node-2."
+  "Finder-specific implementation of `Info-find-node-2'."
   (require 'finder)
   (cond
    ((equal nodename "Top")
@@ -3468,7 +3466,7 @@ Build a menu of the possible matches."
   "Display descriptions of the keywords in the Finder virtual manual.
 In interactive use, a prefix argument directs this command to read
 a list of keywords separated by comma.  After that, it displays a node
-with a list packages that contain all specified keywords."
+with a list of packages that contain all specified keywords."
   (interactive
    (when current-prefix-arg
      (require 'finder)
@@ -3520,14 +3518,14 @@ with a list packages that contain all specified keywords."
 
 (defun Info-get-token (pos start all &optional errorstring)
   "Return the token around POS.
-POS must be somewhere inside the token
+POS must be somewhere inside the token.
 START is a regular expression which will match the
-    beginning of the tokens delimited string
+    beginning of the tokens delimited string.
 ALL is a regular expression with a single
     parenthesized subpattern which is the token to be
     returned.  E.g. '{\(.*\)}' would return any string
     enclosed in braces around POS.
-ERRORSTRING optional fourth argument, controls action on no match
+ERRORSTRING optional fourth argument, controls action on no match:
     nil: return nil
     t: beep
     a string: signal an error, using that string."
@@ -4089,7 +4087,7 @@ The `info-file' property of COMMAND says which Info manual to search.
 If COMMAND has no property, the variable `Info-file-list-for-emacs'
 defines heuristics for which Info manual to try.
 The locations are of the format used in `Info-history', i.e.
-\(FILENAME NODENAME BUFFERPOS\), where BUFFERPOS is the line number
+\(FILENAME NODENAME BUFFERPOS), where BUFFERPOS is the line number
 in the first element of the returned list (which is treated specially in
 `Info-goto-emacs-command-node'), and 0 for the rest elements of a list."
   (let ((where '()) line-number
@@ -4674,7 +4672,7 @@ the variable `Info-file-list-for-emacs'."
 (eval-when-compile (require 'speedbar))
 
 (defvar Info-speedbar-key-map nil
-  "Keymap used when in the info display mode.")
+  "Keymap used when in the Info display mode.")
 
 (defun Info-install-speedbar-variables ()
   "Install those variables used by speedbar to enhance Info."
@@ -4722,7 +4720,7 @@ This will add a speedbar major display mode."
   (speedbar-change-initial-expansion-list "Info")
   )
 
-(defun Info-speedbar-hierarchy-buttons (directory depth &optional node)
+(defun Info-speedbar-hierarchy-buttons (_directory depth &optional node)
   "Display an Info directory hierarchy in speedbar.
 DIRECTORY is the current directory in the attached frame.
 DEPTH is the current indentation depth.
@@ -4756,7 +4754,7 @@ specific node to expand."
 	   t)
 	nil))))
 
-(defun Info-speedbar-goto-node (text node indent)
+(defun Info-speedbar-goto-node (_text node _indent)
   "When user clicks on TEXT, go to an info NODE.
 The INDENT level is ignored."
   (speedbar-select-attached-frame)
@@ -4835,7 +4833,7 @@ NODESPEC is a string of the form: (file)node."
 
 ;;; Info mode node listing
 ;; This is called by `speedbar-add-localized-speedbar-support'
-(defun Info-speedbar-buttons (buffer)
+(defun Info-speedbar-buttons (_buffer)
   "Create a speedbar display to help navigation in an Info file.
 BUFFER is the buffer speedbar is requesting buttons for."
   (if (save-excursion (goto-char (point-min))
@@ -4866,7 +4864,7 @@ BUFFER is the buffer speedbar is requesting buttons for."
 
 ;;;;  Desktop support
 
-(defun Info-desktop-buffer-misc-data (desktop-dirname)
+(defun Info-desktop-buffer-misc-data (_desktop-dirname)
   "Auxiliary information to be saved in desktop file."
   (list Info-current-file
 	Info-current-node
@@ -4878,7 +4876,7 @@ BUFFER is the buffer speedbar is requesting buttons for."
 			 'slow Info-current-file Info-current-node)
 			(cons 'slow t))))))
 
-(defun Info-restore-desktop-buffer (desktop-buffer-file-name
+(defun Info-restore-desktop-buffer (_desktop-buffer-file-name
                                     desktop-buffer-name
                                     desktop-buffer-misc)
   "Restore an Info buffer specified in a desktop file."

lisp/mh-e/ChangeLog

@@ -1,3 +1,8 @@
+2011-04-06  Juanma Barranquero  <lekktu@gmail.com>
+
+	* mh-funcs.el (mh-undo-folder): Accept and ignore arguments,
+	for compatibility with `revert-buffer'.  Doc fix.  (Bug#8431)
+
 2011-03-05  Antoine Levitt  <antoine.levitt@gmail.com>
 
 	* mh-funcs.el (mh-store-msg, mh-store-buffer):

lisp/mh-e/mh-funcs.el

@@ -349,8 +349,9 @@ See `mh-store-msg' for a description of DIRECTORY."
         (error "Error occurred during execution of %s" command)))))
 
 ;;;###mh-autoload
-(defun mh-undo-folder ()
+(defun mh-undo-folder (&rest _ignored)
-  "Undo all refiles and deletes in the current folder."
+  "Undo all refiles and deletes in the current folder.
+Arguments are IGNORED (for `revert-buffer')."
   (interactive)
   (cond ((or mh-do-not-confirm-flag
              (yes-or-no-p "Undo all commands in folder? "))

lisp/minibuffer.el

@@ -1278,7 +1278,6 @@ Point needs to be somewhere between START and END."
 ;; - pcomplete: pop it down on SPC or after some time-delay.
 ;; - semantic: use a post-command-hook check similar to this one.
 (defun completion-in-region--postch ()
-  (message "completion-in-region--postch: cmd=%s" this-command)
   (or unread-command-events ;Don't pop down the completions in the middle of
                             ;mouse-drag-region/mouse-set-point.
       (and completion-in-region--data
@@ -1310,10 +1309,8 @@ Point needs to be somewhere between START and END."
         (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
               minor-mode-overriding-map-alist))
   (if (null completion-in-region-mode)
-      (progn
+      (unless (equal "*Completions*" (buffer-name (window-buffer)))
-        (unless (equal "*Completions*" (buffer-name (window-buffer)))
+	(minibuffer-hide-completions))
-          (minibuffer-hide-completions))
-        (message "Leaving completion-in-region-mode"))
     ;; (add-hook 'pre-command-hook #'completion-in-region--prech)
     (add-hook 'post-command-hook #'completion-in-region--postch)
     (push `(completion-in-region-mode . ,completion-in-region-mode-map)