mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

Merge from mainline.

Browse Source
This commit is contained in:
Paul Eggert 2011-04-05 21:52:22 -07:00
commit b70d23ff74
17 changed files with 2602 additions and 2315 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
ChangeLog
View File

@ -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.

161
autogen/update_autogen
View File

@ -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

38
lisp/ChangeLog
View File

@ -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.

20
lisp/Makefile.in
View File

@ -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
# are identified by being the value of `generated-autoload-file'.
# The chmod +w is to handle env var CVSREAD=1.
autoloads: $(LOADDEFS) doit
chmod +w $(lisp)/ps-print.el $(lisp)/emulation/tpu-edt.el \
$(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) && chmod +w $(AUTOGEN_VCS)
cd $(lisp); $(setwins_almost); \
echo Directories: $$wins; \
$(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins

12
lisp/calendar/cal-move.el
View File

@ -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.

17
lisp/calendar/calendar.el
View File

@ -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)
(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)
(if (and (boundp 'x-toolkit-scroll-bars) x-toolkit-scroll-bars)
(define-key map [vertical-scroll-bar mouse-1]
'calendar-scroll-toolkit-scroll)
;; Left-click moves us forward in time, right-click backwards.
(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'.")

3
lisp/font-lock.el
View File

@ -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))

32
lisp/gnus/ChangeLog
View File

@ -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

1318
lisp/gnus/gnus-registry.el
View File

File diff suppressed because it is too large Load Diff

2
lisp/gnus/nnregistry.el
View File

@ -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)

411
lisp/gnus/registry.el Normal file
View File

@ -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

27
lisp/gnus/spam.el
View File

@ -68,9 +68,9 @@
;; autoload gnus-registry
(autoload 'gnus-registry-group-count "gnus-registry")
(autoload 'gnus-registry-add-group "gnus-registry")
(autoload 'gnus-registry-store-extra-entry "gnus-registry")
(autoload 'gnus-registry-fetch-extra "gnus-registry")
(autoload 'gnus-registry-get-id-key "gnus-registry")
(autoload 'gnus-registry-set-id-key "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
id group subject sender))
(gnus-registry-handle-action id nil 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
id
type
cell-list))
(gnus-registry-set-id-key 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
id
type
new-cell-list))
(gnus-registry-set-id-key id type new-cell-list))
(progn
(gnus-error 7 (format
"%s call with bad ID, type, spam-backend, or group"

186
lisp/info.el
View File

@ -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
function to call instead of calling the default corresponding function
to override it.")
symbols `find-node' that define what HANDLER function to call instead
of calling the default corresponding function 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")
(".z" . "gunzip")
(".bz2" . ("bzip2" "-dc"))
(".inz" . "gunzip")
(".igz" . "gunzip")
(".info.Z" . "gunzip")
(".info.gz" . "gunzip")
("-info.Z" . "gunzip")
("-info.gz" . "gunzip")
("/index.gz". "gunzip")
("/index.z" . "gunzip")
(".inf" . nil)
(".info" . nil)
("-info" . nil)
("/index" . nil)
("" . nil))
'( (".info.Z". "uncompress")
(".info.Y". "unyabba")
(".info.gz". "gunzip")
(".info.z". "gunzip")
(".info.bz2" . ("bzip2" "-dc"))
(".info.xz". "unxz")
(".info". nil)
("-info.Z". "uncompress")
("-info.Y". "unyabba")
("-info.gz". "gunzip")
("-info.bz2" . ("bzip2" "-dc"))
("-info.z". "gunzip")
("-info.xz". "unxz")
("-info". nil)
("/index.Z". "uncompress")
("/index.Y". "unyabba")
("/index.gz". "gunzip")
("/index.z". "gunzip")
("/index.bz2". ("bzip2" "-dc"))
("/index.xz". "unxz")
("/index". nil)
(".Z". "uncompress")
(".Y". "unyabba")
(".gz". "gunzip")
(".z". "gunzip")
(".bz2" . ("bzip2" "-dc"))
(".xz". "unxz")
("". nil)))
'( (".gz" . "gunzip")
(".z" . "gunzip")
(".bz2" . ("bzip2" "-dc"))
(".inz" . "gunzip")
(".igz" . "gunzip")
(".info.Z" . "gunzip")
(".info.gz" . "gunzip")
("-info.Z" . "gunzip")
("-info.gz" . "gunzip")
("/index.gz" . "gunzip")
("/index.z" . "gunzip")
(".inf" . nil)
(".info" . nil)
("-info" . nil)
("/index" . nil)
("" . nil))
'( (".info.Z" . "uncompress")
(".info.Y" . "unyabba")
(".info.gz" . "gunzip")
(".info.z" . "gunzip")
(".info.bz2" . ("bzip2" "-dc"))
(".info.xz" . "unxz")
(".info" . nil)
("-info.Z" . "uncompress")
("-info.Y" . "unyabba")
("-info.gz" . "gunzip")
("-info.bz2" . ("bzip2" "-dc"))
("-info.z" . "gunzip")
("-info.xz" . "unxz")
("-info" . nil)
("/index.Z" . "uncompress")
("/index.Y" . "unyabba")
("/index.gz" . "gunzip")
("/index.z" . "gunzip")
("/index.bz2" . ("bzip2" "-dc"))
("/index.xz" . "unxz")
("/index" . nil)
(".Z" . "uncompress")
(".Y" . "unyabba")
(".gz" . "gunzip")
(".z" . "gunzip")
(".bz2" . ("bzip2" "-dc"))
(".xz" . "unxz")
("" . 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
whitespace separated list of KEY=VALUE pairs. If VALUE contains
whitespace or double quotes, it must be quoted in double quotes and
any double quotes or backslashes must be escaped (\\\",\\\\)."
"Return alist of (\"KEY\" . \"VALUE\") from PARAMETER-STRING.
PARAMETER-STRING is a whitespace separated list of KEY=VALUE pairs.
If VALUE contains whitespace or double quotes, it must be quoted
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.
PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
"Virtual completion table for file names input in Info node names."
(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)
"Directory-specific implementation of Info-find-file."
(defun Info-directory-find-file (filename &optional _noerror)
"Directory-specific implementation of `Info-find-file'."
filename)
(defun Info-directory-find-node (filename nodename &optional no-going-back)
"Directory-specific implementation of Info-find-node-2."
(defun Info-directory-find-node (_filename _nodename &optional _no-going-back)
"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)
"History-specific implementation of Info-find-file."
(defun Info-history-find-file (filename &optional _noerror)
"History-specific implementation of `Info-find-file'."
filename)
(defun Info-history-find-node (filename nodename &optional no-going-back)
"History-specific implementation of Info-find-node-2."
(defun Info-history-find-node (filename nodename &optional _no-going-back)
"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)
"Toc-specific implementation of Info-find-node-2."
(defun Info-toc-find-node (filename nodename &optional _no-going-back)
"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)
"Index-specific implementation of Info-find-node-2."
(defun Info-virtual-index-find-node (filename nodename &optional _no-going-back)
"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)
nodename)
(ohist-list Info-history-list))
;; 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)
"Apropos-specific implementation of Info-find-file."
(defun Info-apropos-find-file (filename &optional _noerror)
"Apropos-specific implementation of `Info-find-file'."
filename)
(defun Info-apropos-find-node (filename nodename &optional no-going-back)
"Apropos-specific implementation of Info-find-node-2."
(defun Info-apropos-find-node (_filename nodename &optional _no-going-back)
"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)
"Finder-specific implementation of Info-find-file."
(defun Info-finder-find-file (filename &optional _noerror)
"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)
"Finder-specific implementation of Info-find-node-2."
(defun Info-finder-find-node (_filename nodename &optional _no-going-back)
"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."

2659
lisp/ldefs-boot.el
View File

File diff suppressed because one or more lines are too long

5
lisp/mh-e/ChangeLog
View File

@ -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):

5
lisp/mh-e/mh-funcs.el
View File

@ -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 ()
"Undo all refiles and deletes in the current folder."
(defun mh-undo-folder (&rest _ignored)
"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? "))

7
lisp/minibuffer.el
View File

@ -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)))
(minibuffer-hide-completions))
(message "Leaving completion-in-region-mode"))
(unless (equal "*Completions*" (buffer-name (window-buffer)))
(minibuffer-hide-completions))
;; (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)