aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2010-11-01 16:53:08 +0900
committerKenichi Handa2010-11-01 16:53:08 +0900
commitf6f3366160e26ff5984f287e60616ec9f90acfa3 (patch)
tree9f5c8dc73cad6319a8fdf1ab22fd4e9901089e50
parent65b6b59a8030b09d2a32ee88837a061e22751988 (diff)
parentca7c89d8f52b34f694031f496600f949640ff9c4 (diff)
downloademacs-f6f3366160e26ff5984f287e60616ec9f90acfa3.tar.gz
emacs-f6f3366160e26ff5984f287e60616ec9f90acfa3.zip
merge trunk
-rw-r--r--ChangeLog5
-rw-r--r--admin/notes/bugtracker8
-rwxr-xr-xconfigure12
-rw-r--r--configure.in12
-rw-r--r--doc/lispref/ChangeLog4
-rw-r--r--doc/lispref/maps.texi12
-rw-r--r--doc/misc/ChangeLog31
-rw-r--r--doc/misc/cc-mode.texi11
-rw-r--r--doc/misc/gnus.texi72
-rw-r--r--doc/misc/makefile.w32-in10
-rw-r--r--doc/misc/mh-e.texi10
-rw-r--r--etc/MH-E-NEWS8
-rw-r--r--etc/NEWS129
-rw-r--r--lisp/ChangeLog212
-rw-r--r--lisp/abbrev.el4
-rw-r--r--lisp/cedet/ChangeLog28
-rw-r--r--lisp/cedet/ede.el7
-rw-r--r--lisp/cedet/ede/proj-elisp.el14
-rw-r--r--lisp/cedet/mode-local.el27
-rw-r--r--lisp/cedet/semantic/analyze/debug.el44
-rw-r--r--lisp/cedet/semantic/bovine/c.el15
-rw-r--r--lisp/cedet/semantic/ede-grammar.el11
-rw-r--r--lisp/cedet/semantic/symref.el3
-rw-r--r--lisp/cedet/semantic/symref/cscope.el3
-rw-r--r--lisp/cedet/semantic/symref/list.el148
-rw-r--r--lisp/cedet/semantic/tag-file.el3
-rw-r--r--lisp/composite.el7
-rw-r--r--lisp/cus-start.el96
-rw-r--r--lisp/emacs-lisp/bytecomp.el76
-rw-r--r--lisp/emacs-lisp/easy-mmode.el5
-rw-r--r--lisp/emacs-lisp/lisp-mode.el5
-rw-r--r--lisp/emacs-lisp/package.el12
-rw-r--r--lisp/emacs-lisp/pcase.el69
-rw-r--r--lisp/emacs-lisp/smie.el351
-rw-r--r--lisp/faces.el5
-rw-r--r--lisp/files.el27
-rw-r--r--lisp/finder.el3
-rw-r--r--lisp/gnus/ChangeLog277
-rw-r--r--lisp/gnus/gnus-art.el76
-rw-r--r--lisp/gnus/gnus-cite.el39
-rw-r--r--lisp/gnus/gnus-dired.el6
-rw-r--r--lisp/gnus/gnus-ems.el96
-rw-r--r--lisp/gnus/gnus-group.el40
-rw-r--r--lisp/gnus/gnus-int.el2
-rw-r--r--lisp/gnus/gnus-msg.el8
-rw-r--r--lisp/gnus/gnus-srvr.el4
-rw-r--r--lisp/gnus/gnus-start.el148
-rw-r--r--lisp/gnus/gnus-sum.el34
-rw-r--r--lisp/gnus/gnus-util.el68
-rw-r--r--lisp/gnus/gnus.el187
-rw-r--r--lisp/gnus/mail-source.el6
-rw-r--r--lisp/gnus/message.el4
-rw-r--r--lisp/gnus/mm-decode.el7
-rw-r--r--lisp/gnus/mm-util.el46
-rw-r--r--lisp/gnus/mm-view.el2
-rw-r--r--lisp/gnus/nndoc.el3
-rw-r--r--lisp/gnus/nnimap.el73
-rw-r--r--lisp/gnus/nnir.el940
-rw-r--r--lisp/gnus/nnmail.el5
-rw-r--r--lisp/gnus/nnmairix.el2
-rw-r--r--lisp/gnus/nntp.el8
-rw-r--r--lisp/gnus/shr.el87
-rw-r--r--lisp/gnus/sieve-manage.el5
-rw-r--r--lisp/gnus/smime.el7
-rw-r--r--lisp/info.el9
-rw-r--r--lisp/menu-bar.el7
-rw-r--r--lisp/mouse-sel.el9
-rw-r--r--lisp/net/gnutls.el6
-rw-r--r--lisp/net/tramp.el6
-rw-r--r--lisp/play/fortune.el43
-rw-r--r--lisp/play/gomoku.el9
-rw-r--r--lisp/play/landmark.el5
-rw-r--r--lisp/progmodes/ada-mode.el10
-rw-r--r--lisp/progmodes/cc-cmds.el24
-rw-r--r--lisp/progmodes/cc-fonts.el46
-rw-r--r--lisp/progmodes/octave-mod.el55
-rw-r--r--lisp/progmodes/prolog.el23
-rw-r--r--lisp/progmodes/ruby-mode.el9
-rw-r--r--lisp/progmodes/sql.el4
-rw-r--r--lisp/select.el5
-rw-r--r--lisp/simple.el31
-rw-r--r--lisp/speedbar.el10
-rw-r--r--lisp/startup.el34
-rw-r--r--lisp/term/w32console.el4
-rw-r--r--lisp/term/x-win.el7
-rw-r--r--lisp/textmodes/bibtex.el35
-rw-r--r--lisp/textmodes/ispell.el7
-rw-r--r--lisp/tool-bar.el16
-rw-r--r--lisp/vc/add-log.el4
-rw-r--r--lisp/vc/log-edit.el2
-rw-r--r--lisp/vc/vc-arch.el2
-rw-r--r--lisp/vc/vc-cvs.el2
-rw-r--r--lisp/vc/vc-mtn.el2
-rw-r--r--lisp/vc/vc-rcs.el2
-rw-r--r--lisp/vc/vc-sccs.el2
-rw-r--r--src/ChangeLog37
-rw-r--r--src/buffer.c23
-rw-r--r--src/dbusbind.c12
-rw-r--r--src/emacs.c2
-rw-r--r--src/filelock.c6
-rw-r--r--src/frame.c10
-rw-r--r--src/nsfns.m26
-rw-r--r--src/w32fns.c10
-rw-r--r--src/xfns.c8
-rw-r--r--src/xterm.c68
105 files changed, 2381 insertions, 1930 deletions
diff --git a/ChangeLog b/ChangeLog
index 4e6cd3d3deb..33a7cf784ab 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
12010-10-31 Ken Brown <kbrown@cornell.edu>
2
3 * configure.in (checking whether localtime caches TZ): Use
4 unsetenv instead of modifying environment directly.
5
12010-10-25 Andreas Schwab <schwab@linux-m68k.org> 62010-10-25 Andreas Schwab <schwab@linux-m68k.org>
2 7
3 * configure.in (checking for -znocombreloc): Use AC_LANG_PROGRAM 8 * configure.in (checking for -znocombreloc): Use AC_LANG_PROGRAM
diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker
index 5b3af5e242c..9c7631fdfae 100644
--- a/admin/notes/bugtracker
+++ b/admin/notes/bugtracker
@@ -384,6 +384,14 @@ fixed 123 23.0.60
384*** To remove a "fixed" mark: 384*** To remove a "fixed" mark:
385notfixed 123 23.0.60 385notfixed 123 23.0.60
386 386
387*** To make a bug as present in a particular version:
388found 123 23.2
389NB if there is no specified "fixed" version, or if there is one and it
390is earlier than the found version, this reopens a closed bug.
391
392The leading "23.1;" that M-x report-emacs-bug adds to bug subjects
393automatically sets a found version (if none is explicitly specified).
394
387*** To assign or reassign a bug to a package or list of packages: 395*** To assign or reassign a bug to a package or list of packages:
388reassign 1234 emacs 396reassign 1234 emacs
389 397
diff --git a/configure b/configure
index c12401e2d16..3e3f91d4537 100755
--- a/configure
+++ b/configure
@@ -13982,14 +13982,6 @@ else
13982 cat confdefs.h - <<_ACEOF >conftest.$ac_ext 13982 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
13983/* end confdefs.h. */ 13983/* end confdefs.h. */
13984#include <time.h> 13984#include <time.h>
13985extern char **environ;
13986unset_TZ ()
13987{
13988 char **from, **to;
13989 for (to = from = environ; (*to = *from); from++)
13990 if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '='))
13991 to++;
13992}
13993char TZ_GMT0[] = "TZ=GMT0"; 13985char TZ_GMT0[] = "TZ=GMT0";
13994char TZ_PST8[] = "TZ=PST8"; 13986char TZ_PST8[] = "TZ=PST8";
13995main() 13987main()
@@ -13999,13 +13991,13 @@ main()
13999 if (putenv (TZ_GMT0) != 0) 13991 if (putenv (TZ_GMT0) != 0)
14000 exit (1); 13992 exit (1);
14001 hour_GMT0 = localtime (&now)->tm_hour; 13993 hour_GMT0 = localtime (&now)->tm_hour;
14002 unset_TZ (); 13994 unsetenv("TZ");
14003 hour_unset = localtime (&now)->tm_hour; 13995 hour_unset = localtime (&now)->tm_hour;
14004 if (putenv (TZ_PST8) != 0) 13996 if (putenv (TZ_PST8) != 0)
14005 exit (1); 13997 exit (1);
14006 if (localtime (&now)->tm_hour == hour_GMT0) 13998 if (localtime (&now)->tm_hour == hour_GMT0)
14007 exit (1); 13999 exit (1);
14008 unset_TZ (); 14000 unsetenv("TZ");
14009 if (localtime (&now)->tm_hour != hour_unset) 14001 if (localtime (&now)->tm_hour != hour_unset)
14010 exit (1); 14002 exit (1);
14011 exit (0); 14003 exit (0);
diff --git a/configure.in b/configure.in
index fb64f0b346a..d53830b5ba2 100644
--- a/configure.in
+++ b/configure.in
@@ -2952,14 +2952,6 @@ AC_MSG_CHECKING(whether localtime caches TZ)
2952AC_CACHE_VAL(emacs_cv_localtime_cache, 2952AC_CACHE_VAL(emacs_cv_localtime_cache,
2953[if test x$ac_cv_func_tzset = xyes; then 2953[if test x$ac_cv_func_tzset = xyes; then
2954AC_TRY_RUN([#include <time.h> 2954AC_TRY_RUN([#include <time.h>
2955extern char **environ;
2956unset_TZ ()
2957{
2958 char **from, **to;
2959 for (to = from = environ; (*to = *from); from++)
2960 if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '='))
2961 to++;
2962}
2963char TZ_GMT0[] = "TZ=GMT0"; 2955char TZ_GMT0[] = "TZ=GMT0";
2964char TZ_PST8[] = "TZ=PST8"; 2956char TZ_PST8[] = "TZ=PST8";
2965main() 2957main()
@@ -2969,13 +2961,13 @@ main()
2969 if (putenv (TZ_GMT0) != 0) 2961 if (putenv (TZ_GMT0) != 0)
2970 exit (1); 2962 exit (1);
2971 hour_GMT0 = localtime (&now)->tm_hour; 2963 hour_GMT0 = localtime (&now)->tm_hour;
2972 unset_TZ (); 2964 unsetenv("TZ");
2973 hour_unset = localtime (&now)->tm_hour; 2965 hour_unset = localtime (&now)->tm_hour;
2974 if (putenv (TZ_PST8) != 0) 2966 if (putenv (TZ_PST8) != 0)
2975 exit (1); 2967 exit (1);
2976 if (localtime (&now)->tm_hour == hour_GMT0) 2968 if (localtime (&now)->tm_hour == hour_GMT0)
2977 exit (1); 2969 exit (1);
2978 unset_TZ (); 2970 unsetenv("TZ");
2979 if (localtime (&now)->tm_hour != hour_unset) 2971 if (localtime (&now)->tm_hour != hour_unset)
2980 exit (1); 2972 exit (1);
2981 exit (0); 2973 exit (0);
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index afd20c3890a..5607d179aad 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,7 @@
12010-10-31 Glenn Morris <rgm@gnu.org>
2
3 * maps.texi (Standard Keymaps): Update File menu description.
4
12010-10-28 Glenn Morris <rgm@gnu.org> 52010-10-28 Glenn Morris <rgm@gnu.org>
2 6
3 * Makefile.in (elisp.dvi, elisp.pdf): Also include $emacsdir. 7 * Makefile.in (elisp.dvi, elisp.pdf): Also include $emacsdir.
diff --git a/doc/lispref/maps.texi b/doc/lispref/maps.texi
index a5b126afcb2..4b416a82d64 100644
--- a/doc/lispref/maps.texi
+++ b/doc/lispref/maps.texi
@@ -1,7 +1,8 @@
1@c -*-texinfo-*- 1@c -*-texinfo-*-
2@c This is part of the GNU Emacs Lisp Reference Manual. 2@c This is part of the GNU Emacs Lisp Reference Manual.
3@c Copyright (C) 1990, 1991, 1992, 1993, 1999, 2001, 2002, 2003, 2004, 3@c Copyright (C) 1990, 1991, 1992, 1993, 1999, 2001, 2002, 2003, 2004,
4@c 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4@c 2005, 2006, 2007, 2008, 2009, 2010
5@c Free Software Foundation, Inc.
5@c See the file elisp.texi for copying conditions. 6@c See the file elisp.texi for copying conditions.
6@setfilename ../../info/maps 7@setfilename ../../info/maps
7@node Standard Keymaps, Standard Hooks, Standard Buffer-Local Variables, Top 8@node Standard Keymaps, Standard Hooks, Standard Buffer-Local Variables, Top
@@ -183,9 +184,9 @@ A sparse keymap used by Lisp mode.
183@vindex menu-bar-edit-menu 184@vindex menu-bar-edit-menu
184The keymap which displays the Edit menu in the menu bar. 185The keymap which displays the Edit menu in the menu bar.
185 186
186@item menu-bar-files-menu 187@item menu-bar-file-menu
187@vindex menu-bar-files-menu 188@vindex menu-bar-file-menu
188The keymap which displays the Files menu in the menu bar. 189The keymap which displays the File menu in the menu bar.
189 190
190@item menu-bar-help-menu 191@item menu-bar-help-menu
191@vindex menu-bar-help-menu 192@vindex menu-bar-help-menu
@@ -239,6 +240,3 @@ The keymap defining the contents of the tool bar.
239A full keymap used by View mode. 240A full keymap used by View mode.
240@end table 241@end table
241 242
242@ignore
243 arch-tag: b741253c-7e23-4a02-b3fa-cffd9e4d72b9
244@end ignore
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 029d2e039bb..5e99132389e 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,32 @@
12010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * gnus.texi (Paging the Article): Document C-u g/C-u C-u g.
4
52010-10-31 Glenn Morris <rgm@gnu.org>
6
7 * mh-e.texi (Preface, From Bill Wohler): Change 23 to past tense.
8
92010-10-31 Glenn Morris <rgm@gnu.org>
10
11 * cc-mode.texi: Remove reference to defunct viewcvs URL.
12
132010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
14
15 * gnus.texi (Client-Side IMAP Splitting): Mention
16 nnimap-unsplittable-articles.
17
182010-10-29 Julien Danjou <julien@danjou.info>
19
20 * gnus.texi (Finding the News): Remove references to obsoletes
21 variables `gnus-nntp-server' and `gnus-secondary-servers'.
22
232010-10-29 Eli Zaretskii <eliz@gnu.org>
24
25 * makefile.w32-in (MAKEINFO): Add -I$(emacsdir).
26 (ENVADD): Remove extra -I$(emacsdir), included in $(MAKEINFO).
27 ($(infodir)/efaq): Remove -I$(emacsdir), included in $(MAKEINFO).
28 ($(infodir)/calc, calc.dvi): Depend on $(emacsdir)/emacsver.texi.
29
12010-10-28 Glenn Morris <rgm@gnu.org> 302010-10-28 Glenn Morris <rgm@gnu.org>
2 31
3 * Makefile.in (MAKEINFO, ENVADD): Add $emacsdir to include path. 32 * Makefile.in (MAKEINFO, ENVADD): Add $emacsdir to include path.
@@ -12,7 +41,7 @@
12 41
132010-10-24 Jay Belanger <jay.p.belanger@gmail.com> 422010-10-24 Jay Belanger <jay.p.belanger@gmail.com>
14 43
15 * calc.texi: Use emacsver.texi to determine Emacs version. 44 * calc.texi: Use emacsver.texi to determine Emacs version.
16 45
172010-10-24 Juanma Barranquero <lekktu@gmail.com> 462010-10-24 Juanma Barranquero <lekktu@gmail.com>
18 47
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 73ee0e107d3..da8e7082909 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -160,7 +160,8 @@ CC Mode
160This manual is for CC Mode in Emacs. 160This manual is for CC Mode in Emacs.
161 161
162Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 162Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
1632003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 1632003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
164Free Software Foundation, Inc.
164 165
165@quotation 166@quotation
166Permission is granted to copy, distribute and/or modify this document 167Permission is granted to copy, distribute and/or modify this document
@@ -201,9 +202,8 @@ developing GNU and promoting software freedom.''
201@vskip 0pt plus 1filll 202@vskip 0pt plus 1filll
202@insertcopying 203@insertcopying
203 204
204This manual was generated from cc-mode.texi, which can be downloaded 205This manual was generated from cc-mode.texi, which is distributed with Emacs,
205from 206or can be downloaded from @url{http://savannah.gnu.org/projects/emacs/}.
206@url{http://cvs.savannah.gnu.org/viewcvs/emacs/emacs/doc/misc/cc-mode.texi}.
207@end titlepage 207@end titlepage
208 208
209@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 209@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7015,6 +7015,3 @@ Since most @ccmode{} variables are prepended with the string
7015 7015
7016@bye 7016@bye
7017 7017
7018@ignore
7019 arch-tag: c4cab162-5e57-4366-bdce-4a9db2fc97f0
7020@end ignore
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index e0a3ca280b5..c3dd2b31a50 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -1020,22 +1020,6 @@ Gnus will see whether @code{gnus-nntpserver-file}
1020If that fails as well, Gnus will try to use the machine running Emacs 1020If that fails as well, Gnus will try to use the machine running Emacs
1021as an @acronym{NNTP} server. That's a long shot, though. 1021as an @acronym{NNTP} server. That's a long shot, though.
1022 1022
1023@vindex gnus-nntp-server
1024If @code{gnus-nntp-server} is set, this variable will override
1025@code{gnus-select-method}. You should therefore set
1026@code{gnus-nntp-server} to @code{nil}, which is what it is by default.
1027
1028@vindex gnus-secondary-servers
1029@vindex gnus-nntp-server
1030You can also make Gnus prompt you interactively for the name of an
1031@acronym{NNTP} server. If you give a non-numerical prefix to @code{gnus}
1032(i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers
1033in the @code{gnus-secondary-servers} list (if any). You can also just
1034type in the name of any server you feel like visiting. (Note that this
1035will set @code{gnus-nntp-server}, which means that if you then @kbd{M-x
1036gnus} later in the same Emacs session, Gnus will contact the same
1037server.)
1038
1039@findex gnus-group-browse-foreign-server 1023@findex gnus-group-browse-foreign-server
1040@kindex B (Group) 1024@kindex B (Group)
1041However, if you use one @acronym{NNTP} server regularly and are just 1025However, if you use one @acronym{NNTP} server regularly and are just
@@ -5204,24 +5188,6 @@ used for fetching the file.
5204If fetching from the first site is unsuccessful, Gnus will attempt to go 5188If fetching from the first site is unsuccessful, Gnus will attempt to go
5205through @code{gnus-group-faq-directory} and try to open them one by one. 5189through @code{gnus-group-faq-directory} and try to open them one by one.
5206 5190
5207@item H C
5208@kindex H C (Group)
5209@findex gnus-group-fetch-control
5210@vindex gnus-group-fetch-control-use-browse-url
5211@cindex control message
5212Fetch the control messages for the group from the archive at
5213@code{ftp.isc.org} (@code{gnus-group-fetch-control}). Query for a
5214group if given a prefix argument.
5215
5216If @code{gnus-group-fetch-control-use-browse-url} is non-@code{nil},
5217Gnus will open the control messages in a browser using
5218@code{browse-url}. Otherwise they are fetched using @code{ange-ftp}
5219and displayed in an ephemeral group.
5220
5221Note that the control messages are compressed. To use this command
5222you need to turn on @code{auto-compression-mode} (@pxref{Compressed
5223Files, ,Compressed Files, emacs, The Emacs Manual}).
5224
5225@item H d 5191@item H d
5226@itemx C-c C-d 5192@itemx C-c C-d
5227@c @icon{gnus-group-describe-group} 5193@c @icon{gnus-group-describe-group}
@@ -6187,8 +6153,9 @@ Scroll the current article one line backward
6187@vindex gnus-summary-show-article-charset-alist 6153@vindex gnus-summary-show-article-charset-alist
6188(Re)fetch the current article (@code{gnus-summary-show-article}). If 6154(Re)fetch the current article (@code{gnus-summary-show-article}). If
6189given a prefix, fetch the current article, but don't run any of the 6155given a prefix, fetch the current article, but don't run any of the
6190article treatment functions. This will give you a ``raw'' article, just 6156article treatment functions. If given a prefix twice (i.e., @kbd{C-u
6191the way it came from the server. 6157C-u g'}), show a completely ``raw'' article, just the way it came from
6158the server.
6192 6159
6193@cindex charset, view article with different charset 6160@cindex charset, view article with different charset
6194If given a numerical prefix, you can do semi-manual charset stuff. 6161If given a numerical prefix, you can do semi-manual charset stuff.
@@ -13462,14 +13429,20 @@ the headers of the article; if the value is @code{nil}, the header
13462name will be removed. If the attribute name is @code{eval}, the form 13429name will be removed. If the attribute name is @code{eval}, the form
13463is evaluated, and the result is thrown away. 13430is evaluated, and the result is thrown away.
13464 13431
13465The attribute value can be a string (used verbatim), a function with 13432The attribute value can be a string, a function with zero arguments
13466zero arguments (the return value will be used), a variable (its value 13433(the return value will be used), a variable (its value will be used)
13467will be used) or a list (it will be @code{eval}ed and the return value 13434or a list (it will be @code{eval}ed and the return value will be
13468will be used). The functions and sexps are called/@code{eval}ed in the 13435used). The functions and sexps are called/@code{eval}ed in the
13469message buffer that is being set up. The headers of the current article 13436message buffer that is being set up. The headers of the current
13470are available through the @code{message-reply-headers} variable, which 13437article are available through the @code{message-reply-headers}
13471is a vector of the following headers: number subject from date id 13438variable, which is a vector of the following headers: number subject
13472references chars lines xref extra. 13439from date id references chars lines xref extra.
13440
13441In the case of a string value, if the @code{match} is a regular
13442expression, a @samp{gnus-match-substitute-replacement} is proceed on
13443the value to replace the positional parameters @samp{\@var{n}} by the
13444corresponding parenthetical matches (see @xref{Replacing the Text that
13445Matched, , Text Replacement, elisp, The Emacs Lisp Reference Manual}.)
13473 13446
13474@vindex message-reply-headers 13447@vindex message-reply-headers
13475 13448
@@ -14945,6 +14918,11 @@ use the value of the @code{nnmail-split-methods} variable.
14945@item nnimap-split-fancy 14918@item nnimap-split-fancy
14946Uses the same syntax as @code{nnmail-split-fancy}. 14919Uses the same syntax as @code{nnmail-split-fancy}.
14947 14920
14921@item nnimap-unsplittable-articles
14922List of flag symbols to ignore when doing splitting. That is,
14923articles that have these flags won't be considered when splitting.
14924The default is @samp{(%Deleted %Seen)}.
14925
14948@end table 14926@end table
14949 14927
14950 14928
@@ -30102,11 +30080,11 @@ that means:
30102(setq gnus-read-active-file 'some) 30080(setq gnus-read-active-file 'some)
30103@end lisp 30081@end lisp
30104 30082
30105On the other hand, if the manual says ``set @code{gnus-nntp-server} to 30083On the other hand, if the manual says ``set @code{gnus-nntp-server-file} to
30106@samp{nntp.ifi.uio.no}'', that means: 30084@samp{/etc/nntpserver}'', that means:
30107 30085
30108@lisp 30086@lisp
30109(setq gnus-nntp-server "nntp.ifi.uio.no") 30087(setq gnus-nntp-server-file "/etc/nntpserver")
30110@end lisp 30088@end lisp
30111 30089
30112So be careful not to mix up strings (the latter) with symbols (the 30090So be careful not to mix up strings (the latter) with symbols (the
diff --git a/doc/misc/makefile.w32-in b/doc/misc/makefile.w32-in
index f4887738411..fd3b1476b55 100644
--- a/doc/misc/makefile.w32-in
+++ b/doc/misc/makefile.w32-in
@@ -32,7 +32,7 @@ infodir = $(srcdir)/../../info
32emacsdir = $(srcdir)/../emacs 32emacsdir = $(srcdir)/../emacs
33 33
34# The makeinfo program is part of the Texinfo distribution. 34# The makeinfo program is part of the Texinfo distribution.
35MAKEINFO = makeinfo --force 35MAKEINFO = makeinfo --force -I$(emacsdir)
36MULTI_INSTALL_INFO = $(srcdir)\..\..\nt\multi-install-info.bat 36MULTI_INSTALL_INFO = $(srcdir)\..\..\nt\multi-install-info.bat
37INFO_TARGETS = $(infodir)/ccmode \ 37INFO_TARGETS = $(infodir)/ccmode \
38 $(infodir)/cl $(infodir)/dbus $(infodir)/dired-x \ 38 $(infodir)/cl $(infodir)/dbus $(infodir)/dired-x \
@@ -70,7 +70,7 @@ INFOSOURCES = info.texi
70 70
71TEXI2DVI = texi2dvi 71TEXI2DVI = texi2dvi
72ENVADD = $(srcdir)\..\..\nt\envadd.bat "TEXINPUTS=$(srcdir);$(TEXINPUTS)" \ 72ENVADD = $(srcdir)\..\..\nt\envadd.bat "TEXINPUTS=$(srcdir);$(TEXINPUTS)" \
73 "MAKEINFO=$(MAKEINFO) -I$(srcdir) -I$(emacsdir)" /C 73 "MAKEINFO=$(MAKEINFO) -I$(srcdir)" /C
74 74
75 75
76info: $(INFO_TARGETS) 76info: $(INFO_TARGETS)
@@ -218,7 +218,7 @@ widget.dvi: widget.texi
218 $(ENVADD) $(TEXI2DVI) $(srcdir)/widget.texi 218 $(ENVADD) $(TEXI2DVI) $(srcdir)/widget.texi
219 219
220$(infodir)/efaq: faq.texi $(emacsdir)/emacsver.texi 220$(infodir)/efaq: faq.texi $(emacsdir)/emacsver.texi
221 $(MAKEINFO) -I$(emacsdir) faq.texi 221 $(MAKEINFO) faq.texi
222faq.dvi: faq.texi $(emacsdir)/emacsver.texi 222faq.dvi: faq.texi $(emacsdir)/emacsver.texi
223 $(ENVADD) $(TEXI2DVI) $(srcdir)/faq.texi 223 $(ENVADD) $(TEXI2DVI) $(srcdir)/faq.texi
224 224
@@ -227,10 +227,10 @@ $(infodir)/autotype: autotype.texi
227autotype.dvi: autotype.texi 227autotype.dvi: autotype.texi
228 $(ENVADD) $(TEXI2DVI) $(srcdir)/autotype.texi 228 $(ENVADD) $(TEXI2DVI) $(srcdir)/autotype.texi
229 229
230$(infodir)/calc: calc.texi 230$(infodir)/calc: calc.texi $(emacsdir)/emacsver.texi
231 $(MAKEINFO) calc.texi 231 $(MAKEINFO) calc.texi
232 232
233calc.dvi: calc.texi 233calc.dvi: calc.texi $(emacsdir)/emacsver.texi
234 $(ENVADD) $(TEXI2DVI) $(srcdir)/calc.texi 234 $(ENVADD) $(TEXI2DVI) $(srcdir)/calc.texi
235 235
236# This is produced with --no-split to avoid making files whose 236# This is produced with --no-split to avoid making files whose
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index ed64f91ac39..a06a7231112 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -213,7 +213,7 @@ more niceties about GNU Emacs and MH@. Now I'm fully hooked on both of
213them. 213them.
214 214
215The MH-E package is distributed with GNU Emacs@footnote{Version 215The MH-E package is distributed with GNU Emacs@footnote{Version
216@value{VERSION} of MH-E will appear in GNU Emacs 23.1. It is supported 216@value{VERSION} of MH-E appeared in GNU Emacs 23.1. It is supported
217in GNU Emacs 21 and 22, as well as XEmacs 21 (except for versions 217in GNU Emacs 21 and 22, as well as XEmacs 21 (except for versions
21821.5.9-21.5.16). It is compatible with MH versions 6.8.4 and higher, 21821.5.9-21.5.16). It is compatible with MH versions 6.8.4 and higher,
219all versions of nmh, and GNU mailutils 1.0 and higher.}, so you 219all versions of nmh, and GNU mailutils 1.0 and higher.}, so you
@@ -8951,8 +8951,8 @@ files that were already part of Emacs) and the software was completely
8951reorganized to push back two decades of entropy. Version 8 appeared in 8951reorganized to push back two decades of entropy. Version 8 appeared in
8952Emacs 22.1 in 2006. 8952Emacs 22.1 in 2006.
8953 8953
8954Development was then quiet for a couple of years. Emacs 23.1, which is 8954Development was then quiet for a couple of years. Emacs 23.1, released
8955due out in 2009, will contain version 8.1. This version includes a few 8955in June 2009, contains version 8.2. This version includes a few
8956new features and several bug fixes. 8956new features and several bug fixes.
8957 8957
8958Bill Wohler, August 2008 8958Bill Wohler, August 2008
@@ -9061,6 +9061,4 @@ Bill Wohler, August 2008
9061@c sentence-end-double-space: nil 9061@c sentence-end-double-space: nil
9062@c End: 9062@c End:
9063 9063
9064@ignore 9064
9065 arch-tag: b778477d-1a10-4a99-84de-f877a2ea6bef
9066@end ignore
diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS
index 1141b9dd3fa..f4bf030eb32 100644
--- a/etc/MH-E-NEWS
+++ b/etc/MH-E-NEWS
@@ -1,13 +1,13 @@
1* COPYRIGHT 1* COPYRIGHT
2 2
3Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 3Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
4 Free Software Foundation, Inc. 4 2010 Free Software Foundation, Inc.
5See the end of the file for license conditions. 5See the end of the file for license conditions.
6 6
7 7
8* Changes in MH-E 8.2 8* Changes in MH-E 8.2
9 9
10Version 8.2 of MH-E will appear in GNU Emacs 23.1. This is a small 10Version 8.2 of MH-E appeared in GNU Emacs 23.1. This is a small
11release that includes internal changes from the Emacs team. A new 11release that includes internal changes from the Emacs team. A new
12hook, `mh-pack-folder-hook', has been added. 12hook, `mh-pack-folder-hook', has been added.
13 13
@@ -231,7 +231,7 @@ gatewayed at gmane.org (closes SF #979308).
231If you want to see the release notes for the alpha and beta releases 231If you want to see the release notes for the alpha and beta releases
232leading up this release, please see: 232leading up this release, please see:
233 233
234 http://cvs.savannah.gnu.org/viewcvs/emacs/etc/MH-E-NEWS?rev=1.25&root=emacs&view=markup 234 http://cvs.savannah.gnu.org/viewvc/emacs/emacs/etc/MH-E-NEWS?revision=1.25&view=markup
235 235
236 236
237 237
diff --git a/etc/NEWS b/etc/NEWS
index ff2c2101f1b..33118fc5136 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -187,7 +187,7 @@ for `list-colors-display'.
187 187
188** An Emacs Lisp package manager is now included. 188** An Emacs Lisp package manager is now included.
189This is a convenient way to download and install additional packages, 189This is a convenient way to download and install additional packages,
190from elpa.gnu.org. 190from a package repository at elpa.gnu.org.
191 191
192*** `M-x list-packages' shows a list of packages, which can be 192*** `M-x list-packages' shows a list of packages, which can be
193selected for installation. 193selected for installation.
@@ -227,8 +227,8 @@ and no prefix argument is given. If set to `kill', these commands
227kill instead. 227kill instead.
228 228
229*** New command `delete-forward-char', bound to C-d and [delete]. 229*** New command `delete-forward-char', bound to C-d and [delete].
230This is meant for interactive use, and obeys `delete-active-region'; 230This is meant for interactive use, and obeys `delete-active-region'.
231delete-char, meant for Lisp, does not obey `delete-active-region'. 231The command `delete-char' does not obey `delete-active-region'.
232 232
233*** `delete-backward-char' is now a Lisp function. 233*** `delete-backward-char' is now a Lisp function.
234Apart from obeying `delete-active-region', its behavior is unchanged. 234Apart from obeying `delete-active-region', its behavior is unchanged.
@@ -240,65 +240,53 @@ should use delete-char with a negative argument instead.
240** Selection changes. 240** Selection changes.
241 241
242The default handling of clipboard and primary selections has been 242The default handling of clipboard and primary selections has been
243changed to conform with other X applications. 243changed to conform with other X applications. The exact changes are
244 244described below; in short, mouse commands to select and paste text now
245The new behavior is that by default Emacs does not put selected text 245use the primary selection, while all other commands for killing and
246into the clipboard, and does not add it to kill-ring, merely because 246yanking text now use the clipboard.
247the text was selected. Only commands that kill text or copy it to the
248kill-ring (C-w, M-w, C-k, etc.) put the killed text into the
249clipboard. Selected text is put into the primary selection (on
250systems, such as X, that support the primary selection separately from
251the clipboard).
252
253Similarly, Emacs by default does not retrieve text from the clipboard
254when the mouse (e.g., mouse-2) is used for pasting text selected in
255another application. Mouse commands that paste text retrieve text
256from the primary selection, on systems that support it separately from
257the clipboard. Text from the clipboard is retrieved only by C-y, M-y
258and other commands that yank text from the kill-ring.
259
260In other words, the default behavior is that mouse gestures that
261select and paste text work with the primary selection (on X), while
262keyboard commands that kill/copy and paste text work with the
263clipboard.
264
265This change also means that the "Copy", "Cut", and "Paste" items of
266the menu-bar "Edit" menu are now exactly equivalent to, respectively
267M-w, C-w, and C-y.
268
269To get back the previous behavior, whereby mouse gestures set the
270clipboard and retrieve text from there, customize the variables
271`mouse-drag-copy-region' and (on X only) `x-select-enable-primary' to
272non-nil values. If you don't want Emacs to put the text into the
273clipboard, only to the primary selection, additionally customize
274`x-select-enable-clipboard' to nil.
275
276These changes in the default behavior are reflected in the default
277values of several variables:
278
279*** `select-active-regions' now defaults to t, so active regions set
280the primary selection. It was nil in previous versions.
281 247
248*** Merely selecting text (e.g. with drag-mouse-1) does not add it to
249the kill-ring. On systems with a primary selection separate from the
250clipboard (such as X), the selected text is put in the primary
251selection.
252
253*** mouse-2 is now bound to `mouse-yank-primary', which pastes from
254the primary selection regardless of the contents of the kill-ring.
255
256*** Commands that kill text or copy it to the kill-ring (M-w, C-w,
257C-k, etc.) also put the killed text into the clipboard. This change
258also means that the "Copy", "Cut", and "Paste" items in the "Edit"
259menu are now exactly equivalent to, respectively M-w, C-w, and C-y.
260
261*** Yank commands, such as C-y and M-y, retrieve text from the
262clipboard if it is available.
263
264*** The above changes are reflected in the following new defaults:
265
266**** `select-active-regions' now defaults to t.
282It also accepts a new value, `only', which means to only set the 267It also accepts a new value, `only', which means to only set the
283primary selection for temporarily active regions (usually made by 268primary selection for temporarily active regions (usually made by
284mouse-dragging or shift-selection). 269mouse-dragging or shift-selection).
285 270
286*** `mouse-2' is now bound to `mouse-yank-primary'. 271**** `mouse-2' is now bound to `mouse-yank-primary'.
287Previously, it was bound to `mouse-yank-at-click' (which is now 272Previously, it was bound to `mouse-yank-at-click' (which is now
288unbound by default). 273unbound by default).
289 274
290*** `x-select-enable-clipboard' now defaults to t on all platforms. 275**** `x-select-enable-clipboard' now defaults to t on all platforms.
291Thus, killing and yanking now use the clipboard (in addition to the 276Note that this variable was already non-nil by default on MS-Windows,
292kill ring). Note that this variable was already non-nil by default on 277which does not support the primary selection between applications.
293MS-Windows, which does not support the primary selection between
294applications.
295 278
296*** `x-select-enable-primary' now defaults to nil. 279**** `x-select-enable-primary' now defaults to nil.
297This variable exists only on X; its default value was t in previous 280This variable exists only on X; its default value was t in previous
298versions. 281versions.
299 282
300*** `mouse-drag-copy-region' now defaults to nil. 283**** `mouse-drag-copy-region' now defaults to nil.
301Its previous default value was t. 284
285*** To return to the previous behavior, where mouse commands use the
286clipboard, change `mouse-drag-copy-region' and (on X only)
287`x-select-enable-primary' to t. If you don't want Emacs to put the
288text into the clipboard, only to the primary selection, additionally
289set `x-select-enable-clipboard' to nil.
302 290
303*** Support for X cut buffers has been removed. 291*** Support for X cut buffers has been removed.
304 292
@@ -350,7 +338,7 @@ view-diary-entries, list-diary-entries, show-all-diary-entries
350 338
351*** Customize buffers now contain a search field. 339*** Customize buffers now contain a search field.
352The search is performed using `customize-apropos'. 340The search is performed using `customize-apropos'.
353To turn off the search field, set custom-search-field to nil . 341To turn off the search field, set custom-search-field to nil.
354 342
355*** Custom options now start out hidden if at their default values. 343*** Custom options now start out hidden if at their default values.
356Use the arrow to the left of the option name to toggle visibility. 344Use the arrow to the left of the option name to toggle visibility.
@@ -365,41 +353,6 @@ choose a color via list-colors-display.
365*** dired-jump and dired-jump-other-window called with a prefix argument 353*** dired-jump and dired-jump-other-window called with a prefix argument
366read a file name from the minibuffer instead of using buffer-file-name. 354read a file name from the minibuffer instead of using buffer-file-name.
367 355
368** VC and related modes
369
370*** New VC commands: vc-log-incoming, vc-log-outgoing, vc-find-conflicted-file.
371
372**** vc-log-incoming for Git runs "git fetch" so that the necessary
373data is available locally.
374
375**** vc-log-incoming and vc-log-outgoing for Git require version 1.7 (or newer).
376
377*** New key bindings: C-x v I and C-x v O bound to vc-log-incoming and
378vc-log-outgoing, respectively.
379
380*** The 'g' key in VC diff, log, log-incoming and log-outgoing buffers
381reruns the corresponding VC command to compute an up to date version
382of the buffer.
383
384*** vc-dir for Bzr supports viewing shelve contents and shelving snapshots.
385
386*** Special markup can be added to log-edit buffers.
387The log-edit buffers are expected to have a format similar to email messages
388with headers of the form:
389 Author: <author of this change>
390 Summary: <one line summary of this change>
391 Fixes: <reference to the bug fixed by this change>
392Some backends handle some of those headers specially, but any unknown header
393is just left as is in the message, so it is not lost.
394
395**** vc-git handles Author: and Date:
396**** vc-hg handles Author: and Date:
397**** vc-bzr handles Author:, Date: and Fixes:
398**** vc-mtn handles Author: and Date:
399
400*** Pressing g in a *vc-diff* buffer reruns vc-diff, so it will
401produce an up to date diff.
402
403** Directory local variables can apply to file-less buffers. 356** Directory local variables can apply to file-less buffers.
404For example, adding "(diff-mode . ((mode . whitespace)))" to your 357For example, adding "(diff-mode . ((mode . whitespace)))" to your
405.dir-locals.el file, will turn on `whitespace-mode' for *vc-diff* buffers. 358.dir-locals.el file, will turn on `whitespace-mode' for *vc-diff* buffers.
@@ -587,6 +540,8 @@ Notifications API. It requires D-Bus for communication.
587 540
588* Incompatible Lisp Changes in Emacs 24.1 541* Incompatible Lisp Changes in Emacs 24.1
589 542
543** Remove obsolete name `e' (use `float-e' instead).
544
590** A backquote not followed by a space is now always treated as new-style. 545** A backquote not followed by a space is now always treated as new-style.
591 546
592** Test for special mode-class was moved from view-file to view-buffer. 547** Test for special mode-class was moved from view-file to view-buffer.
@@ -630,6 +585,8 @@ font-lock-defaults-alist
630** The following files, obsolete since at least Emacs 21.1, have been removed: 585** The following files, obsolete since at least Emacs 21.1, have been removed:
631sc.el, x-menu.el, rnews.el, rnewspost.el 586sc.el, x-menu.el, rnews.el, rnewspost.el
632 587
588** FIXME finder-inf.el changes.
589
633 590
634* Lisp changes in Emacs 24.1 591* Lisp changes in Emacs 24.1
635 592
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5d2e442a1c1..9be6d045de3 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -12,6 +12,185 @@
12 12
13 * faces.el (glyphless-char): New face. 13 * faces.el (glyphless-char): New face.
14 14
152010-11-01 Glenn Morris <rgm@gnu.org>
16
17 * emacs-lisp/smie.el (smie): New custom group.
18 (smie-blink-matching-inners, smie-indent-basic): Add :group.
19
20 * faces.el (xw-defined-colors, x-setup-function-keys):
21 * mouse-sel.el (x-select-text):
22 * term/w32console.el (x-setup-function-keys): Update declarations.
23
24 * progmodes/ruby-mode.el (ruby-syntax-propertize-heredoc): Declare.
25
26 * textmodes/ispell.el (comment-add): Declare.
27
28 * net/gnutls.el (gnutls-boot, gnutls-errorp, gnutls-error-string):
29 Declare.
30
31 * info.el (finder-keywords-hash, package-alist): Declare.
32
332010-11-01 Chong Yidong <cyd@stupidchicken.com>
34
35 * finder.el (finder-compile-keywords): Don't use intern-soft,
36 since package names may not yet exist in the obarray.
37
382010-11-01 Chong Yidong <cyd@stupidchicken.com>
39
40 * vc/vc-arch.el (vc-arch-checkin):
41 * vc/vc-cvs.el (vc-cvs-checkin):
42 * vc/vc-mtn.el (vc-mtn-checkin):
43 * vc/vc-rcs.el (vc-rcs-checkin):
44 * vc/vc-sccs.el (vc-sccs-checkin):
45 * vc/vc-svn.el (vc-svn-checkin): Remove optional extra arg, unused
46 since 2010-04-21 commit by Stefan Monnier.
47
482010-11-01 Glenn Morris <rgm@gnu.org>
49
50 * emacs-lisp/bytecomp.el (byte-recompile-file): Fix previous change.
51
52 * startup.el (package-enable-at-startup, package-initialize):
53 Silence compiler.
54
55 * progmodes/ada-mode.el (ada-font-lock-syntactic-keywords):
56 Silence compiler.
57
582010-10-31 Julien Danjou <julien@danjou.info>
59
60 * emacs-lisp/bytecomp.el (byte-recompile-file): New fun (bug#7297).
61 (byte-recompile-directory):
62 * emacs-lisp/lisp-mode.el (emacs-lisp-byte-compile-and-load):
63 Use `byte-recompile-file'.
64
652010-10-31 Glenn Morris <rgm@gnu.org>
66
67 * cus-start.el: Handle standard values via a keyword.
68 Only set version property if specified.
69 (cursor-in-non-selected-windows, menu-bar-mode)
70 (tool-bar-mode, show-trailing-whitespace):
71 Do not specify standard values.
72 (transient-mark-mode, temporary-file-directory): Use :standard.
73
742010-10-31 Jan Djärv <jan.h.d@swipnet.se>
75
76 * term/x-win.el (x-get-selection-value): New function that gets
77 PRIMARY with type as specified in x-select-request-type. (Bug#6802).
78
792010-10-31 Michael Albinus <michael.albinus@gmx.de>
80
81 * net/tramp.el (tramp-handle-insert-file-contents): For root,
82 preserve owner and group when editing files. (Bug#7289)
83
842010-10-31 Glenn Morris <rgm@gnu.org>
85
86 * speedbar.el (speedbar-mode):
87 * play/fortune.el (fortune-in-buffer, fortune):
88 * play/gomoku.el (gomoku-mode):
89 * play/landmark.el (lm-mode):
90 * textmodes/bibtex.el (bibtex-validate, bibtex-validate-globally):
91 Replace inappropriate uses of toggle-read-only. (Bug#7292)
92
93 * select.el (x-selection): Mark it as an obsolete alias.
94
952010-10-31 Aaron S. Hawley <aaron.s.hawley@gmail.com>
96
97 * vc/add-log.el (find-change-log): Use derived-mode-p rather than
98 major-mode (bug#7284).
99
1002010-10-31 Glenn Morris <rgm@gnu.org>
101
102 * menu-bar.el (menu-bar-files-menu): Make it into an actual alias,
103 rather than just an unused variable that inherits from the real one.
104
1052010-10-31 Alan Mackenzie <acm@muc.de>
106
107 * progmodes/cc-cmds.el (c-mask-paragraph): Fix an off-by-1 error.
108 This fixes bug #7185.
109
1102010-10-30 Chong Yidong <cyd@stupidchicken.com>
111
112 * startup.el (command-line): Search for package directories, and
113 don't load package.el if none are found.
114
115 * emacs-lisp/package.el (describe-package, list-packages): Call
116 package-initialize if it has not been called yet.
117
1182010-10-30 Alan Mackenzie <acm@muc.de>
119
120 * progmodes/cc-fonts.el (c-font-lock-enum-tail): New function
121 which fontifies the tail of an enum.
122 (c-basic-matchers-after): Insert a call to the above new function.
123 This fixes bug #7264.
124
1252010-10-30 Glenn Morris <rgm@gnu.org>
126
127 * cus-start.el: Add :set properties for minor modes menu-bar-mode,
128 tool-bar-mode, transient-mark-mode. (Bug#7306)
129 Include the :set property in the dumped Emacs.
130
1312010-10-29 Stefan Monnier <monnier@iro.umontreal.ca>
132
133 SMIE: change indent rules format, improve smie-setup.
134 * emacs-lisp/smie.el (smie-precs-precedence-table)
135 (smie-merge-prec2s, smie-bnf-precedence-table, smie-prec2-levels):
136 Mark them pure so the tables gets built at compile time.
137 (smie-bnf-precedence-table): Store the closer-alist in the table.
138 (smie-prec2-levels): Preserve the closer-alist.
139 (smie-blink-matching-open): Be more forgiving in case of indentation.
140 (smie-hanging-p): Rename from smie-indent--hanging-p.
141 (smie-bolp): Rename from smie-indent--bolp.
142 (smie--parent, smie--after): New dynamic vars.
143 (smie-parent-p, smie-next-p, smie-prev-p): New funs.
144 (smie-indent-rules): Remove.
145 (smie-indent--offset-rule): Remove fun.
146 (smie-rules-function): New var.
147 (smie-indent--rule): New fun.
148 (smie-indent--offset, smie-indent-keyword, smie-indent-after-keyword)
149 (smie-indent-exps): Use it.
150 (smie-setup): Setup paren blinking; add keyword args for token
151 functions; extract closer-alist from op-levels.
152 (smie-indent-debug-log): Remove var.
153 (smie-indent-debug): Remove fun.
154 * progmodes/prolog.el (prolog-smie-indent-rules): Remove.
155 (prolog-smie-rules): New fun to replace it.
156 (prolog-mode-variables): Simplify.
157 * progmodes/octave-mod.el (octave-smie-closer-alist): Remove, now that
158 it's setup automatically.
159 (octave-smie-indent-rules): Remove.
160 (octave-smie-rules): New fun to replace it.
161 (octave-mode): Simplify.
162
1632010-10-29 Glenn Morris <rgm@gnu.org>
164
165 * files.el (temporary-file-directory): Remove (already defined in C).
166 * cus-start.el: Add temporary-file-directory.
167
168 * abbrev.el (abbrev-mode):
169 * composite.el (auto-composition-mode):
170 * menu-bar.el (menu-bar-mode):
171 * simple.el (transient-mark-mode):
172 * tool-bar.el (tool-bar-mode): Adjust the define-minor-mode calls so
173 that they do not define the associated variables twice.
174 * simple.el (transient-mark-mode): Remove defvar.
175 * composite.el (auto-composition-mode): Make variable auto-buffer-local.
176 * cus-start.el: Add transient-mark-mode, menu-bar-mode, tool-bar-mode.
177 Handle multiple groups, and also custom-delayed-init-variables.
178 * emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix.
179
1802010-10-29 Stefan Monnier <monnier@iro.umontreal.ca>
181
182 * emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
183 (pcase-if): Add one minor optimization.
184 (pcase-split-equal): Rename from pcase-split-eq.
185 (pcase-split-member): Rename from pcase-split-memq.
186 (pcase-u1): Add strings to the member optimization.
187 Add `guard' variant of predicates.
188 (pcase-q1): Add string patterns.
189
1902010-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
191
192 * vc/log-edit.el (log-edit-rewrite-fixes): State its safety pred.
193
152010-10-28 Glenn Morris <rgm@gnu.org> 1942010-10-28 Glenn Morris <rgm@gnu.org>
16 195
17 * term/ns-win.el (global-map, menu-bar-final-items, menu-bar-help-menu): 196 * term/ns-win.el (global-map, menu-bar-final-items, menu-bar-help-menu):
@@ -171,13 +350,13 @@
171 auto-built for efficiency of execution and updating. 350 auto-built for efficiency of execution and updating.
172 (verilog-extended-complete-re): Support 'pure' fucntion & task 351 (verilog-extended-complete-re): Support 'pure' fucntion & task
173 declarations (these have no bodies). 352 declarations (these have no bodies).
174 (verilog-beg-of-statement): general cleanup to enable support of 353 (verilog-beg-of-statement): General cleanup to enable support of
175 'pure' fucntion & task declarations (these have no bodies). These 354 'pure' fucntion & task declarations (these have no bodies).
176 efforts together fix Verilog bug210 from veripool; which was also 355 These efforts together fix Verilog bug210 from veripool; which was also
177 noticed by Steve Pearlmutter. 356 noticed by Steve Pearlmutter.
178 (verilog-directive-re, verilog-directive-begin, verilog-indent-re) 357 (verilog-directive-re, verilog-directive-begin, verilog-indent-re)
179 (verilog-directive-nest-re, verilog-set-auto-endcomments): Support 358 (verilog-directive-nest-re, verilog-set-auto-endcomments):
180 `elsif. Reported by Shankar Giri. 359 Support `elsif. Reported by Shankar Giri.
181 (verilog-forward-ws&directives, verilog-in-attribute-p): Fixes for 360 (verilog-forward-ws&directives, verilog-in-attribute-p): Fixes for
182 attribute handling for lining up declarations and assignments. 361 attribute handling for lining up declarations and assignments.
183 (verilog-beg-of-statement-1): Fix issue where continued declaration 362 (verilog-beg-of-statement-1): Fix issue where continued declaration
@@ -185,8 +364,7 @@
185 (verilog-in-attribute-p, verilog-skip-backward-comments) 364 (verilog-in-attribute-p, verilog-skip-backward-comments)
186 (verilog-skip-forward-comment-p): Support proper treatment of 365 (verilog-skip-forward-comment-p): Support proper treatment of
187 attributes by indent code. Reported by Jeff Steele. 366 attributes by indent code. Reported by Jeff Steele.
188 (verilog-in-directive-p): Fix comment to correctly describe 367 (verilog-in-directive-p): Fix comment to correctly describe function.
189 function.
190 (verilog-backward-up-list, verilog-in-struct-region-p) 368 (verilog-backward-up-list, verilog-in-struct-region-p)
191 (verilog-backward-token, verilog-in-struct-p) 369 (verilog-backward-token, verilog-in-struct-p)
192 (verilog-in-coverage-p, verilog-do-indent) 370 (verilog-in-coverage-p, verilog-do-indent)
@@ -213,7 +391,7 @@
213 parameter in AUTOINSTPARAM. 391 parameter in AUTOINSTPARAM.
214 (verilog-read-always-signals-recurse, verilog-read-decls): Fix not 392 (verilog-read-always-signals-recurse, verilog-read-decls): Fix not
215 treating `elsif similar to `endif inside AUTOSENSE. 393 treating `elsif similar to `endif inside AUTOSENSE.
216 (verilog-do-indent): Implement correct automatic or static task or 394 (verilog-do-indent): Implement correct automatic or static task or
217 function end comment highlight. Reported by Steve Pearlmutter. 395 function end comment highlight. Reported by Steve Pearlmutter.
218 (verilog-font-lock-keywords-2): Fix highlighting of single 396 (verilog-font-lock-keywords-2): Fix highlighting of single
219 character pins, bug264. Reported by Michael Laajanen. 397 character pins, bug264. Reported by Michael Laajanen.
@@ -221,15 +399,15 @@
221 (verilog-read-sub-decls-in-interfaced, verilog-read-sub-decls-sig) 399 (verilog-read-sub-decls-in-interfaced, verilog-read-sub-decls-sig)
222 (verilog-subdecls-get-interfaced, verilog-subdecls-new): Support 400 (verilog-subdecls-get-interfaced, verilog-subdecls-new): Support
223 interfaces with AUTOINST, bug270. Reported by Luis Gutierrez. 401 interfaces with AUTOINST, bug270. Reported by Luis Gutierrez.
224 (verilog-pretty-expr): Fix interactive arguments, bug272. Reported 402 (verilog-pretty-expr): Fix interactive arguments, bug272.
225 by Mark Johnson. 403 Reported by Mark Johnson.
226 (verilog-auto-tieoff, verilog-auto-tieoff-ignore-regexp): Add 404 (verilog-auto-tieoff, verilog-auto-tieoff-ignore-regexp):
227 'verilog-auto-tieoff-ignore-regexp' for AUTOTIEOFF, 405 Add 'verilog-auto-tieoff-ignore-regexp' for AUTOTIEOFF,
228 bug269. Suggested by Gary Delp. 406 bug269. Suggested by Gary Delp.
229 (verilog-mode-map, verilog-preprocess, verilog-preprocess-history) 407 (verilog-mode-map, verilog-preprocess, verilog-preprocess-history)
230 (verilog-preprocessor, verilog-set-compile-command): Create 408 (verilog-preprocessor, verilog-set-compile-command):
231 verilog-preprocess and verilog-preprocessor to show preprocessed 409 Create verilog-preprocess and verilog-preprocessor to show
232 output. 410 preprocessed output.
233 (verilog-get-beg-of-line, verilog-get-end-of-line) 411 (verilog-get-beg-of-line, verilog-get-end-of-line)
234 (verilog-modi-file-or-buffer, verilog-modi-name) 412 (verilog-modi-file-or-buffer, verilog-modi-name)
235 (verilog-modi-point, verilog-within-string): Move defmacro's 413 (verilog-modi-point, verilog-within-string): Move defmacro's
@@ -277,8 +455,8 @@
277 (verilog-modi-lookup-last-current, verilog-modi-lookup-last-mod) 455 (verilog-modi-lookup-last-current, verilog-modi-lookup-last-mod)
278 (verilog-modi-lookup-last-modi, verilog-modi-lookup-last-tick): 456 (verilog-modi-lookup-last-modi, verilog-modi-lookup-last-tick):
279 Fix slow verilog-auto expansion on very large files. 457 Fix slow verilog-auto expansion on very large files.
280 (verilog-read-sub-decls-expr, verilog-read-sub-decls-line): Fix 458 (verilog-read-sub-decls-expr, verilog-read-sub-decls-line):
281 AUTOOUTPUT treating "1*2" as a signal name in submodule connection 459 Fix AUTOOUTPUT treating "1*2" as a signal name in submodule connection
282 "{1*2{...". Broke in last revision. 460 "{1*2{...". Broke in last revision.
283 (verilog-read-sub-decls-expr): Fix AUTOOUTPUT not detecting 461 (verilog-read-sub-decls-expr): Fix AUTOOUTPUT not detecting
284 submodule connections with replications "{#{a},#{b}}". 462 submodule connections with replications "{#{a},#{b}}".
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 1c21aee5662..9d0e86fbce8 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -57,7 +57,9 @@ define global abbrevs instead."
57 "Toggle Abbrev mode in the current buffer. 57 "Toggle Abbrev mode in the current buffer.
58With optional argument ARG, turn abbrev mode on if ARG is 58With optional argument ARG, turn abbrev mode on if ARG is
59positive, otherwise turn it off. In Abbrev mode, inserting an 59positive, otherwise turn it off. In Abbrev mode, inserting an
60abbreviation causes it to expand and be replaced by its expansion.") 60abbreviation causes it to expand and be replaced by its expansion."
61 ;; It's defined in C, this stops the d-m-m macro defining it again.
62 :variable abbrev-mode)
61 63
62(put 'abbrev-mode 'safe-local-variable 'booleanp) 64(put 'abbrev-mode 'safe-local-variable 'booleanp)
63 65
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index bc024355b96..69213bb5778 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,31 @@
12010-11-01 Glenn Morris <rgm@gnu.org>
2
3 * semantic/bovine/c.el (semantic-analyze-split-name): Move before use.
4
5 * semantic/symref/cscope.el (ede-toplevel):
6 * semantic/symref.el (ede-toplevel):
7 * semantic/tag-file.el (ede-toplevel):
8 * ede.el (ede-toplevel): Fix declarations.
9
102010-10-31 Glenn Morris <rgm@gnu.org>
11
12 * ede/proj-elisp.el (project-compile-target): Fix previous change.
13 * semantic/ede-grammar.el (project-compile-target): Fix previous change.
14
152010-10-31 Julien Danjou <julien@danjou.info>
16
17 * ede/proj-elisp.el (project-compile-target):
18 * semantic/ede-grammar.el (project-compile-target):
19 Use `byte-recompile-file'.
20
212010-10-31 Glenn Morris <rgm@gnu.org>
22
23 * mode-local.el (mode-local-augment-function-help):
24 * semantic/analyze/debug.el (semantic-analyzer-debug-add-buttons):
25 * semantic/symref/list.el (semantic-symref-results-dump)
26 (semantic-symref-rb-toggle-expand-tag): Replace inappropriate uses
27 of toggle-read-only.
28
12010-09-30 Chong Yidong <cyd@stupidchicken.com> 292010-09-30 Chong Yidong <cyd@stupidchicken.com>
2 30
3 * semantic/bovine/el.el: 31 * semantic/bovine/el.el:
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index fbe66d12202..849cc05019e 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1,7 +1,7 @@
1;;; ede.el --- Emacs Development Environment gloss 1;;; ede.el --- Emacs Development Environment gloss
2 2
3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007,
4;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2008, 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Author: Eric M. Ludlam <zappo@gnu.org> 6;; Author: Eric M. Ludlam <zappo@gnu.org>
7;; Keywords: project, make 7;; Keywords: project, make
@@ -56,7 +56,7 @@
56(declare-function ede-directory-project-p "ede/files") 56(declare-function ede-directory-project-p "ede/files")
57(declare-function ede-find-subproject-for-directory "ede/files") 57(declare-function ede-find-subproject-for-directory "ede/files")
58(declare-function ede-project-directory-remove-hash "ede/files") 58(declare-function ede-project-directory-remove-hash "ede/files")
59(declare-function ede-toplevel "ede/files") 59(declare-function ede-toplevel "ede/base")
60(declare-function ede-toplevel-project "ede/files") 60(declare-function ede-toplevel-project "ede/files")
61(declare-function ede-up-directory "ede/files") 61(declare-function ede-up-directory "ede/files")
62(declare-function semantic-lex-make-spp-table "semantic/lex-spp") 62(declare-function semantic-lex-make-spp-table "semantic/lex-spp")
@@ -1278,5 +1278,4 @@ is the project to use, instead of `ede-current-project'."
1278 (ede-speedbar-file-setup) 1278 (ede-speedbar-file-setup)
1279 (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup)) 1279 (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup))
1280 1280
1281;; arch-tag: 0e1e0eba-484f-4119-abdb-30951f725705
1282;;; ede.el ends here 1281;;; ede.el ends here
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index 879f36ff4e2..8ae00a8cc4c 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -129,18 +129,13 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)."
129 (utd 0)) 129 (utd 0))
130 (mapc (lambda (src) 130 (mapc (lambda (src)
131 (let* ((fsrc (expand-file-name src dir)) 131 (let* ((fsrc (expand-file-name src dir))
132 (elc (concat (file-name-sans-extension fsrc) ".elc")) 132 (elc (concat (file-name-sans-extension fsrc) ".elc")))
133 ) 133 (if (eq (byte-recompile-file fsrc nil 0) t)
134 (if (or (not (file-exists-p elc)) 134 (setq comp (1+ comp))
135 (file-newer-than-file-p fsrc elc))
136 (progn
137 (setq comp (1+ comp))
138 (byte-compile-file fsrc))
139 (setq utd (1+ utd))))) 135 (setq utd (1+ utd)))))
140 (oref obj source)) 136 (oref obj source))
141 (message "All Emacs Lisp sources are up to date in %s" (object-name obj)) 137 (message "All Emacs Lisp sources are up to date in %s" (object-name obj))
142 (cons comp utd) 138 (cons comp utd)))
143 ))
144 139
145(defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version) 140(defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version)
146 "In a Lisp file, updated a version string for THIS to VERSION. 141 "In a Lisp file, updated a version string for THIS to VERSION.
@@ -390,5 +385,4 @@ Argument THIS is the target which needs to insert an info file."
390 385
391(provide 'ede/proj-elisp) 386(provide 'ede/proj-elisp)
392 387
393;; arch-tag: 3802c94b-d04d-4ecf-9bab-b29ed6e77588
394;;; ede/proj-elisp.el ends here 388;;; ede/proj-elisp.el ends here
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index 8d5772f0840..7943f61fee3 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -1,6 +1,7 @@
1;;; mode-local.el --- Support for mode local facilities 1;;; mode-local.el --- Support for mode local facilities
2;; 2;;
3;; Copyright (C) 2004, 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 3;; Copyright (C) 2004, 2005, 2007, 2008, 2009, 2010
4;; Free Software Foundation, Inc.
4;; 5;;
5;; Author: David Ponce <david@dponce.com> 6;; Author: David Ponce <david@dponce.com>
6;; Maintainer: David Ponce <david@dponce.com> 7;; Maintainer: David Ponce <david@dponce.com>
@@ -610,19 +611,16 @@ PROMPT, INITIAL, HIST, and DEFAULT are the same as for `completing-read'."
610SYMBOL is a function that can be overridden." 611SYMBOL is a function that can be overridden."
611 (with-current-buffer "*Help*" 612 (with-current-buffer "*Help*"
612 (pop-to-buffer (current-buffer)) 613 (pop-to-buffer (current-buffer))
613 (unwind-protect 614 (goto-char (point-min))
614 (progn 615 (unless (re-search-forward "^$" nil t)
615 (toggle-read-only -1) 616 (goto-char (point-max))
616 (goto-char (point-min)) 617 (beginning-of-line)
617 (unless (re-search-forward "^$" nil t) 618 (forward-line -1))
618 (goto-char (point-max)) 619 (let ((inhibit-read-only t))
619 (beginning-of-line) 620 (insert (overload-docstring-extension symbol) "\n")
620 (forward-line -1)) 621 ;; NOTE TO SELF:
621 (insert (overload-docstring-extension symbol) "\n") 622 ;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE
622 ;; NOTE TO SELF: 623 )))
623 ;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE
624 )
625 (toggle-read-only 1))))
626 624
627;; Help for mode-local bindings. 625;; Help for mode-local bindings.
628(defun mode-local-print-binding (symbol) 626(defun mode-local-print-binding (symbol)
@@ -782,5 +780,4 @@ invoked interactively."
782 780
783(provide 'mode-local) 781(provide 'mode-local)
784 782
785;; arch-tag: 14b77823-f93c-4b3d-9116-495f69a6ec07
786;;; mode-local.el ends here 783;;; mode-local.el ends here
diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el
index 490b57bf83a..cfc41e6faf1 100644
--- a/lisp/cedet/semantic/analyze/debug.el
+++ b/lisp/cedet/semantic/analyze/debug.el
@@ -586,34 +586,28 @@ Look for key expressions, and add push-buttons near them."
586 (set-marker orig-buffer (point) (current-buffer)) 586 (set-marker orig-buffer (point) (current-buffer))
587 ;; Get a buffer ready. 587 ;; Get a buffer ready.
588 (with-current-buffer "*Help*" 588 (with-current-buffer "*Help*"
589 (toggle-read-only -1) 589 (let ((inhibit-read-only t))
590 (goto-char (point-min)) 590 (goto-char (point-min))
591 (set (make-local-variable 'semantic-analyzer-debug-orig) orig-buffer) 591 (set (make-local-variable 'semantic-analyzer-debug-orig) orig-buffer)
592 ;; First, add do-in buttons to recommendations. 592 ;; First, add do-in buttons to recommendations.
593 (while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t) 593 (while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t)
594 (let ((fcn (match-string 1))) 594 (let ((fcn (match-string 1)))
595 (when (not (fboundp (intern-soft fcn))) 595 (when (not (fboundp (intern-soft fcn)))
596 (error "Help Err: Can't find %s" fcn)) 596 (error "Help Err: Can't find %s" fcn))
597 (end-of-line) 597 (end-of-line)
598 (insert " ") 598 (insert " ")
599 (insert-button "[ Do It ]" 599 (insert-button "[ Do It ]"
600 'mouse-face 'custom-button-pressed-face 600 'mouse-face 'custom-button-pressed-face
601 'do-fcn fcn 601 'do-fcn fcn
602 'action `(lambda (arg) 602 'action `(lambda (arg)
603 (let ((M semantic-analyzer-debug-orig)) 603 (let ((M semantic-analyzer-debug-orig))
604 (set-buffer (marker-buffer M)) 604 (set-buffer (marker-buffer M))
605 (goto-char M)) 605 (goto-char M))
606 (call-interactively (quote ,(intern-soft fcn)))) 606 (call-interactively (quote ,(intern-soft fcn))))))))
607 )
608 ))
609 ;; Do something else? 607 ;; Do something else?
610
611 ;; Clean up the mess 608 ;; Clean up the mess
612 (toggle-read-only 1) 609 (set-buffer-modified-p nil))))
613 (set-buffer-modified-p nil)
614 )))
615 610
616(provide 'semantic/analyze/debug) 611(provide 'semantic/analyze/debug)
617 612
618;; arch-tag: 943db1e5-47e6-4bec-9989-78ebfadf0358
619;;; semantic/analyze/debug.el ends here 613;;; semantic/analyze/debug.el ends here
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 03d370401af..2bac420a1c5 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1002,6 +1002,13 @@ if something is a constructor. Value should be:
1002where typename is the name of the type, and typeoftype is \"class\" 1002where typename is the name of the type, and typeoftype is \"class\"
1003or \"struct\".") 1003or \"struct\".")
1004 1004
1005(define-mode-local-override semantic-analyze-split-name c-mode (name)
1006 "Split up tag names on colon (:) boundaries."
1007 (let ((ans (split-string name ":")))
1008 (if (= (length ans) 1)
1009 name
1010 (delete "" ans))))
1011
1005(defun semantic-c-reconstitute-token (tokenpart declmods typedecl) 1012(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
1006 "Reconstitute a token TOKENPART with DECLMODS and TYPEDECL. 1013 "Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
1007This is so we don't have to match the same starting text several times. 1014This is so we don't have to match the same starting text several times.
@@ -1559,13 +1566,6 @@ These are constants which are of type TYPE."
1559 (string= (semantic-tag-type type) "enum")) 1566 (string= (semantic-tag-type type) "enum"))
1560 (semantic-tag-type-members type))) 1567 (semantic-tag-type-members type)))
1561 1568
1562(define-mode-local-override semantic-analyze-split-name c-mode (name)
1563 "Split up tag names on colon (:) boundaries."
1564 (let ((ans (split-string name ":")))
1565 (if (= (length ans) 1)
1566 name
1567 (delete "" ans))))
1568
1569(define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist) 1569(define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist)
1570 "Assemble the list of names NAMELIST into a namespace name." 1570 "Assemble the list of names NAMELIST into a namespace name."
1571 (mapconcat 'identity namelist "::")) 1571 (mapconcat 'identity namelist "::"))
@@ -1871,5 +1871,4 @@ For types with a :parent, create faux namespaces to put TAG into."
1871;; generated-autoload-load-name: "semantic/bovine/c" 1871;; generated-autoload-load-name: "semantic/bovine/c"
1872;; End: 1872;; End:
1873 1873
1874;; arch-tag: 263951a8-0f18-445d-8e73-eb8f9ac8e2a3
1875;;; semantic/bovine/c.el ends here 1874;;; semantic/bovine/c.el ends here
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index 184e23c9505..90c72990ca9 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -1,6 +1,7 @@
1;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files 1;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files
2 2
3;;; Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010
4;; Free Software Foundation, Inc.
4 5
5;; Author: Eric M. Ludlam <zappo@gnu.org> 6;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: project, make 7;; Keywords: project, make
@@ -133,11 +134,8 @@ Lays claim to all -by.el, and -wy.el files."
133 (save-excursion 134 (save-excursion
134 (semantic-grammar-create-package)) 135 (semantic-grammar-create-package))
135 (save-buffer) 136 (save-buffer)
136 (let ((cf (concat (semantic-grammar-package) ".el"))) 137 (byte-recompile-file (concat (semantic-grammar-package) ".el") nil 0)))
137 (if (or (not (file-exists-p cf)) 138 (oref obj source)))
138 (file-newer-than-file-p src cf))
139 (byte-compile-file cf)))))
140 (oref obj source)))
141 (message "All Semantic Grammar sources are up to date in %s" (object-name obj))) 139 (message "All Semantic Grammar sources are up to date in %s" (object-name obj)))
142 140
143;;; Makefile generation functions 141;;; Makefile generation functions
@@ -197,5 +195,4 @@ Argument THIS is the target that should insert stuff."
197 195
198(provide 'semantic/ede-grammar) 196(provide 'semantic/ede-grammar)
199 197
200;; arch-tag: 37a06a8d-957a-4fa2-a931-38482d28c24a
201;;; semantic/ede-grammar.el ends here 198;;; semantic/ede-grammar.el ends here
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index d36beffc95f..667efede9ad 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -69,7 +69,7 @@
69(defvar ede-minor-mode) 69(defvar ede-minor-mode)
70(declare-function data-debug-new-buffer "data-debug") 70(declare-function data-debug-new-buffer "data-debug")
71(declare-function data-debug-insert-object-slots "eieio-datadebug") 71(declare-function data-debug-insert-object-slots "eieio-datadebug")
72(declare-function ede-toplevel "ede/files") 72(declare-function ede-toplevel "ede/base")
73(declare-function ede-project-root-directory "ede/files") 73(declare-function ede-project-root-directory "ede/files")
74(declare-function ede-up-directory "ede/files") 74(declare-function ede-up-directory "ede/files")
75 75
@@ -508,5 +508,4 @@ over until it returns nil."
508;; generated-autoload-load-name: "semantic/symref" 508;; generated-autoload-load-name: "semantic/symref"
509;; End: 509;; End:
510 510
511;; arch-tag: 928394b7-19ef-4f76-8cb3-37e9a9891984
512;;; semantic/symref.el ends here 511;;; semantic/symref.el ends here
diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el
index 5847c786147..606570961bf 100644
--- a/lisp/cedet/semantic/symref/cscope.el
+++ b/lisp/cedet/semantic/symref/cscope.el
@@ -27,7 +27,7 @@
27(require 'semantic/symref) 27(require 'semantic/symref)
28 28
29(defvar ede-minor-mode) 29(defvar ede-minor-mode)
30(declare-function ede-toplevel "ede/files") 30(declare-function ede-toplevel "ede/base")
31(declare-function ede-project-root-directory "ede/files") 31(declare-function ede-project-root-directory "ede/files")
32 32
33;;; Code: 33;;; Code:
@@ -91,5 +91,4 @@ Moves cursor to end of the match."
91;; generated-autoload-load-name: "semantic/symref/cscope" 91;; generated-autoload-load-name: "semantic/symref/cscope"
92;; End: 92;; End:
93 93
94;; arch-tag: 7c0a4e02-ade4-407a-9df7-4f948bd61a19
95;;; semantic/symref/cscope.el ends here 94;;; semantic/symref/cscope.el ends here
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index 53044e278ac..9be53d90b08 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -221,49 +221,38 @@ Some useful functions are found in `semantic-format-tag-functions'."
221(defun semantic-symref-results-dump (results) 221(defun semantic-symref-results-dump (results)
222 "Dump the RESULTS into the current buffer." 222 "Dump the RESULTS into the current buffer."
223 ;; Get ready for the insert. 223 ;; Get ready for the insert.
224 (toggle-read-only -1) 224 (let ((inhibit-read-only t))
225 (erase-buffer) 225 (erase-buffer)
226 226 ;; Insert the contents.
227 ;; Insert the contents. 227 (let ((lastfile nil))
228 (let ((lastfile nil) 228 (dolist (T (oref results :hit-tags))
229 ) 229 (unless (equal lastfile (semantic-tag-file-name T))
230 (dolist (T (oref results :hit-tags)) 230 (setq lastfile (semantic-tag-file-name T))
231 231 (insert-button lastfile
232 (when (not (equal lastfile (semantic-tag-file-name T))) 232 'mouse-face 'custom-button-pressed-face
233 (setq lastfile (semantic-tag-file-name T)) 233 'action 'semantic-symref-rb-goto-file
234 (insert-button lastfile 234 'tag T)
235 'mouse-face 'custom-button-pressed-face 235 (insert "\n"))
236 'action 'semantic-symref-rb-goto-file 236 (insert " ")
237 (insert-button "[+]"
238 'mouse-face 'highlight
239 'face nil
240 'action 'semantic-symref-rb-toggle-expand-tag
237 'tag T 241 'tag T
238 ) 242 'state 'closed)
239 (insert "\n")) 243 (insert " ")
240 244 (insert-button (funcall semantic-symref-results-summary-function
241 (insert " ") 245 T nil t)
242 (insert-button "[+]" 246 'mouse-face 'custom-button-pressed-face
243 'mouse-face 'highlight 247 'face nil
244 'face nil 248 'action 'semantic-symref-rb-goto-tag
245 'action 'semantic-symref-rb-toggle-expand-tag 249 'tag T)
246 'tag T 250 (insert "\n")))
247 'state 'closed) 251 ;; Auto expand
248 (insert " ") 252 (when semantic-symref-auto-expand-results
249 (insert-button (funcall semantic-symref-results-summary-function 253 (semantic-symref-list-expand-all)))
250 T nil t) 254 ;; Clean up the mess
251 'mouse-face 'custom-button-pressed-face 255 (set-buffer-modified-p nil))
252 'face nil
253 'action 'semantic-symref-rb-goto-tag
254 'tag T)
255 (insert "\n")
256
257 ))
258
259 ;; Auto expand
260 (when semantic-symref-auto-expand-results
261 (semantic-symref-list-expand-all))
262
263 ;; Clean up the mess
264 (toggle-read-only 1)
265 (set-buffer-modified-p nil)
266 )
267 256
268;;; Commands for semantic-symref-results 257;;; Commands for semantic-symref-results
269;; 258;;
@@ -283,11 +272,9 @@ BUTTON is the button that was clicked."
283 (buff (semantic-tag-buffer tag)) 272 (buff (semantic-tag-buffer tag))
284 (hits (semantic--tag-get-property tag :hit)) 273 (hits (semantic--tag-get-property tag :hit))
285 (state (button-get button 'state)) 274 (state (button-get button 'state))
286 (text nil) 275 (text nil))
287 )
288 (cond 276 (cond
289 ((eq state 'closed) 277 ((eq state 'closed)
290 (toggle-read-only -1)
291 (with-current-buffer buff 278 (with-current-buffer buff
292 (dolist (H hits) 279 (dolist (H hits)
293 (goto-char (point-min)) 280 (goto-char (point-min))
@@ -295,48 +282,42 @@ BUTTON is the button that was clicked."
295 (beginning-of-line) 282 (beginning-of-line)
296 (back-to-indentation) 283 (back-to-indentation)
297 (setq text (cons (buffer-substring (point) (point-at-eol)) text))) 284 (setq text (cons (buffer-substring (point) (point-at-eol)) text)))
298 (setq text (nreverse text)) 285 (setq text (nreverse text)))
299 )
300 (goto-char (button-start button)) 286 (goto-char (button-start button))
301 (forward-char 1) 287 (forward-char 1)
302 (delete-char 1) 288 (let ((inhibit-read-only t))
303 (insert "-") 289 (delete-char 1)
304 (button-put button 'state 'open) 290 (insert "-")
305 (save-excursion 291 (button-put button 'state 'open)
306 (end-of-line) 292 (save-excursion
307 (while text 293 (end-of-line)
308 (insert "\n") 294 (while text
309 (insert " ") 295 (insert "\n")
310 (insert-button (car text) 296 (insert " ")
311 'mouse-face 'highlight 297 (insert-button (car text)
312 'face nil 298 'mouse-face 'highlight
313 'action 'semantic-symref-rb-goto-match 299 'face nil
314 'tag tag 300 'action 'semantic-symref-rb-goto-match
315 'line (car hits)) 301 'tag tag
316 (setq text (cdr text) 302 'line (car hits))
317 hits (cdr hits)))) 303 (setq text (cdr text)
318 (toggle-read-only 1) 304 hits (cdr hits))))))
319 )
320 ((eq state 'open) 305 ((eq state 'open)
321 (toggle-read-only -1) 306 (let ((inhibit-read-only t))
322 (button-put button 'state 'closed) 307 (button-put button 'state 'closed)
323 ;; Delete the various bits. 308 ;; Delete the various bits.
324 (goto-char (button-start button)) 309 (goto-char (button-start button))
325 (forward-char 1)
326 (delete-char 1)
327 (insert "+")
328 (save-excursion
329 (end-of-line)
330 (forward-char 1) 310 (forward-char 1)
331 (delete-region (point) 311 (delete-char 1)
332 (save-excursion 312 (insert "+")
333 (forward-char 1) 313 (save-excursion
334 (forward-line (length hits)) 314 (end-of-line)
335 (point)))) 315 (forward-char 1)
336 (toggle-read-only 1) 316 (delete-region (point)
337 ) 317 (save-excursion
338 )) 318 (forward-char 1)
339 ) 319 (forward-line (length hits))
320 (point)))))))))
340 321
341(defun semantic-symref-rb-goto-file (&optional button) 322(defun semantic-symref-rb-goto-file (&optional button)
342 "Go to the file specified in the symref results buffer. 323 "Go to the file specified in the symref results buffer.
@@ -554,5 +535,4 @@ Return the number of occurrences FUNCTION was operated upon."
554;; generated-autoload-load-name: "semantic/symref/list" 535;; generated-autoload-load-name: "semantic/symref/list"
555;; End: 536;; End:
556 537
557;; arch-tag: e355d9c6-26e0-42d1-9bf1-f4801a54fffa
558;;; semantic/symref/list.el ends here 538;;; semantic/symref/list.el ends here
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index 56b3a490118..ab08ea52dd6 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -32,7 +32,7 @@
32(declare-function semanticdb-table-child-p "semantic/db" t t) 32(declare-function semanticdb-table-child-p "semantic/db" t t)
33(declare-function semanticdb-get-buffer "semantic/db") 33(declare-function semanticdb-get-buffer "semantic/db")
34(declare-function semantic-dependency-find-file-on-path "semantic/dep") 34(declare-function semantic-dependency-find-file-on-path "semantic/dep")
35(declare-function ede-toplevel "ede/files") 35(declare-function ede-toplevel "ede/base")
36 36
37;;; Code: 37;;; Code:
38 38
@@ -214,5 +214,4 @@ file prototypes belong in."
214;; generated-autoload-load-name: "semantic/tag-file" 214;; generated-autoload-load-name: "semantic/tag-file"
215;; End: 215;; End:
216 216
217;; arch-tag: 71d4cf18-c1ec-414c-bb0a-c2ed914c1361
218;;; semantic/tag-file.el ends here 217;;; semantic/tag-file.el ends here
diff --git a/lisp/composite.el b/lisp/composite.el
index 02c78580fff..da7705cf9eb 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -743,7 +743,11 @@ When Auto Composition is enabled, text characters are automatically composed
743by functions registered in `composition-function-table' (which see). 743by functions registered in `composition-function-table' (which see).
744 744
745You can use `global-auto-composition-mode' to turn on 745You can use `global-auto-composition-mode' to turn on
746Auto Composition mode in all buffers (this is the default).") 746Auto Composition mode in all buffers (this is the default)."
747 ;; It's defined in C, this stops the d-m-m macro defining it again.
748 :variable auto-composition-mode)
749;; It's not defined with DEFVAR_PER_BUFFER though.
750(make-variable-buffer-local 'auto-composition-mode)
747 751
748;;;###autoload 752;;;###autoload
749(define-minor-mode global-auto-composition-mode 753(define-minor-mode global-auto-composition-mode
@@ -757,5 +761,4 @@ See `auto-composition-mode' for more information on Auto-Composition mode."
757 761
758 762
759 763
760;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33
761;;; composite.el ends here 764;;; composite.el ends here
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index ceb7bcdfd1a..750b6570158 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -1,7 +1,7 @@
1;;; cus-start.el --- define customization properties of builtins 1;;; cus-start.el --- define customization properties of builtins
2;; 2;;
3;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5;; 5;;
6;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 6;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
7;; Keywords: internal 7;; Keywords: internal
@@ -34,6 +34,19 @@
34 34
35;;; Code: 35;;; Code:
36 36
37;; Elements of this list have the form:
38;; SYMBOL GROUP TYPE VERSION REST...
39;; SYMBOL is the name of the variable.
40;; GROUP is the custom group to which it belongs (may also be a list
41;; of groups)
42;; TYPE is the defcustom :type.
43;; VERSION is the defcustom :version (or nil).
44;; REST is a set of :KEYWORD VALUE pairs. Accepted :KEYWORDs are:
45;; :standard - standard value for SYMBOL (else use current value)
46;; :set - custom-set property
47;; :risky - risky-local-variable property
48;; :safe - safe-local-variable property
49;; :tag - custom-tag property
37(let ((all '(;; alloc.c 50(let ((all '(;; alloc.c
38 (gc-cons-threshold alloc integer) 51 (gc-cons-threshold alloc integer)
39 (garbage-collection-messages alloc boolean) 52 (garbage-collection-messages alloc boolean)
@@ -97,10 +110,15 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
97 (line-spacing display (choice (const :tag "none" nil) integer) 110 (line-spacing display (choice (const :tag "none" nil) integer)
98 "22.1") 111 "22.1")
99 (cursor-in-non-selected-windows 112 (cursor-in-non-selected-windows
100 cursor boolean nil t :tag "Cursor In Non-selected Windows" 113 cursor boolean nil
114 :tag "Cursor In Non-selected Windows"
101 :set #'(lambda (symbol value) 115 :set #'(lambda (symbol value)
102 (set-default symbol value) 116 (set-default symbol value)
103 (force-mode-line-update t))) 117 (force-mode-line-update t)))
118 (transient-mark-mode editing-basics boolean nil
119 :standard (not noninteractive)
120 :initialize custom-initialize-delay
121 :set custom-set-minor-mode)
104 ;; callint.c 122 ;; callint.c
105 (mark-even-if-inactive editing-basics boolean) 123 (mark-even-if-inactive editing-basics boolean)
106 ;; callproc.c 124 ;; callproc.c
@@ -171,6 +189,36 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
171 ;; fileio.c 189 ;; fileio.c
172 (delete-by-moving-to-trash auto-save boolean "23.1") 190 (delete-by-moving-to-trash auto-save boolean "23.1")
173 (auto-save-visited-file-name auto-save boolean) 191 (auto-save-visited-file-name auto-save boolean)
192 ;; filelock.c
193 (temporary-file-directory
194 ;; Darwin section added 24.1, does not seem worth :version bump.
195 files directory nil
196 :standard
197 (file-name-as-directory
198 ;; FIXME ? Should there be Ftemporary_file_directory to do this
199 ;; more robustly (cf set_local_socket in emacsclient.c).
200 ;; It could be used elsewhere, eg Fcall_process_region,
201 ;; server-socket-dir. See bug#7135.
202 (cond ((memq system-type '(ms-dos windows-nt))
203 (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP")
204 "c:/temp"))
205 ((eq system-type 'darwin)
206 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP")
207 ;; See bug#7135.
208 (let ((tmp (ignore-errors
209 (shell-command-to-string
210 "getconf DARWIN_USER_TEMP_DIR"))))
211 (and (stringp tmp)
212 (setq tmp (replace-regexp-in-string
213 "\n\\'" "" tmp))
214 ;; Handles "getconf: Unrecognized variable..."
215 (file-directory-p tmp)
216 tmp))
217 "/tmp"))
218 (t
219 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP")
220 "/tmp"))))
221 :initialize custom-initialize-delay)
174 ;; fns.c 222 ;; fns.c
175 (use-dialog-box menu boolean "21.1") 223 (use-dialog-box menu boolean "21.1")
176 (use-file-dialog menu boolean "22.1") 224 (use-file-dialog menu boolean "22.1")
@@ -185,6 +233,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
185 (other :tag "hidden by keypress" 1)) 233 (other :tag "hidden by keypress" 1))
186 "22.1") 234 "22.1")
187 (make-pointer-invisible mouse boolean "23.2") 235 (make-pointer-invisible mouse boolean "23.2")
236 (menu-bar-mode frames boolean nil
237 ;; FIXME?
238; :initialize custom-initialize-default
239 :set custom-set-minor-mode)
240 (tool-bar-mode (frames mouse) boolean nil
241; :initialize custom-initialize-default
242 :set custom-set-minor-mode)
188 ;; fringe.c 243 ;; fringe.c
189 (overflow-newline-into-fringe fringe boolean) 244 (overflow-newline-into-fringe fringe boolean)
190 ;; indent.c 245 ;; indent.c
@@ -332,7 +387,7 @@ since it could result in memory overflow and make Emacs crash."
332 (other :tag "Always" t)) 387 (other :tag "Always" t))
333 "23.1") 388 "23.1")
334 ;; xdisp.c 389 ;; xdisp.c
335 (show-trailing-whitespace whitespace-faces boolean nil nil 390 (show-trailing-whitespace whitespace-faces boolean nil
336 :safe booleanp) 391 :safe booleanp)
337 (scroll-step windows integer) 392 (scroll-step windows integer)
338 (scroll-conservatively windows integer) 393 (scroll-conservatively windows integer)
@@ -408,13 +463,13 @@ since it could result in memory overflow and make Emacs crash."
408 group (nth 1 this) 463 group (nth 1 this)
409 type (nth 2 this) 464 type (nth 2 this)
410 version (nth 3 this) 465 version (nth 3 this)
466 rest (nthcdr 4 this)
411 ;; If we did not specify any standard value expression above, 467 ;; If we did not specify any standard value expression above,
412 ;; use the current value as the standard value. 468 ;; use the current value as the standard value.
413 standard (if (nthcdr 4 this) 469 standard (if (setq prop (memq :standard rest))
414 (nth 4 this) 470 (cadr prop)
415 (when (default-boundp symbol) 471 (if (default-boundp symbol)
416 (funcall quoter (default-value symbol)))) 472 (funcall quoter (default-value symbol))))
417 rest (nthcdr 5 this)
418 ;; Don't complain about missing variables which are 473 ;; Don't complain about missing variables which are
419 ;; irrelevant to this platform. 474 ;; irrelevant to this platform.
420 native-p (save-match-data 475 native-p (save-match-data
@@ -452,21 +507,28 @@ since it could result in memory overflow and make Emacs crash."
452 (put symbol 'safe-local-variable (cadr prop))) 507 (put symbol 'safe-local-variable (cadr prop)))
453 (if (setq prop (memq :risky rest)) 508 (if (setq prop (memq :risky rest))
454 (put symbol 'risky-local-variable (cadr prop))) 509 (put symbol 'risky-local-variable (cadr prop)))
455 ;; If this is NOT while dumping Emacs, 510 (if (setq prop (memq :set rest))
456 ;; set up the rest of the customization info. 511 (put symbol 'custom-set (cadr prop)))
512 ;; Note this is the _only_ initialize property we handle.
513 (if (eq (cadr (memq :initialize rest)) 'custom-initialize-delay)
514 (push symbol custom-delayed-init-variables))
515 ;; If this is NOT while dumping Emacs, set up the rest of the
516 ;; customization info. This is the stuff that is not needed
517 ;; until someone does M-x customize etc.
457 (unless purify-flag 518 (unless purify-flag
458 ;; Add it to the right group. 519 ;; Add it to the right group(s).
459 (custom-add-to-group group symbol 'custom-variable) 520 (if (listp group)
521 (dolist (g group)
522 (custom-add-to-group g symbol 'custom-variable))
523 (custom-add-to-group group symbol 'custom-variable))
460 ;; Set the type. 524 ;; Set the type.
461 (put symbol 'custom-type type) 525 (put symbol 'custom-type type)
462 (put symbol 'custom-version version) 526 (if version (put symbol 'custom-version version))
463 (while rest 527 (while rest
464 (setq prop (car rest) 528 (setq prop (car rest)
465 propval (cadr rest) 529 propval (cadr rest)
466 rest (nthcdr 2 rest)) 530 rest (nthcdr 2 rest))
467 (cond ((memq prop '(:risky :safe))) ; handled above 531 (cond ((memq prop '(:standard :risky :safe :set))) ; handled above
468 ((eq prop :set)
469 (put symbol 'custom-set propval))
470 ((eq prop :tag) 532 ((eq prop :tag)
471 (put symbol 'custom-tag propval)))))))) 533 (put symbol 'custom-tag propval))))))))
472 534
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b3ac7b83d79..952b69f7ce3 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -37,6 +37,7 @@
37;; ======================================================================== 37;; ========================================================================
38;; Entry points: 38;; Entry points:
39;; byte-recompile-directory, byte-compile-file, 39;; byte-recompile-directory, byte-compile-file,
40;; byte-recompile-file,
40;; batch-byte-compile, batch-byte-recompile-directory, 41;; batch-byte-compile, batch-byte-recompile-directory,
41;; byte-compile, compile-defun, 42;; byte-compile, compile-defun,
42;; display-call-tree 43;; display-call-tree
@@ -1551,23 +1552,10 @@ that already has a `.elc' file."
1551 (not (auto-save-file-name-p bytecomp-source)) 1552 (not (auto-save-file-name-p bytecomp-source))
1552 (not (string-equal dir-locals-file 1553 (not (string-equal dir-locals-file
1553 (file-name-nondirectory 1554 (file-name-nondirectory
1554 bytecomp-source))) 1555 bytecomp-source))))
1555 (setq bytecomp-dest 1556 (progn (let ((bytecomp-res (byte-recompile-file
1556 (byte-compile-dest-file bytecomp-source)) 1557 bytecomp-source
1557 (if (file-exists-p bytecomp-dest) 1558 bytecomp-force bytecomp-arg)))
1558 ;; File was already compiled.
1559 (or bytecomp-force
1560 (file-newer-than-file-p bytecomp-source
1561 bytecomp-dest))
1562 ;; No compiled file exists yet.
1563 (and bytecomp-arg
1564 (or (eq 0 bytecomp-arg)
1565 (y-or-n-p (concat "Compile "
1566 bytecomp-source "? "))))))
1567 (progn (if (and noninteractive (not byte-compile-verbose))
1568 (message "Compiling %s..." bytecomp-source))
1569 (let ((bytecomp-res (byte-compile-file
1570 bytecomp-source)))
1571 (cond ((eq bytecomp-res 'no-byte-compile) 1559 (cond ((eq bytecomp-res 'no-byte-compile)
1572 (setq skip-count (1+ skip-count))) 1560 (setq skip-count (1+ skip-count)))
1573 ((eq bytecomp-res t) 1561 ((eq bytecomp-res t)
@@ -1595,6 +1583,59 @@ This is normally set in local file variables at the end of the elisp file:
1595;; Local Variables:\n;; no-byte-compile: t\n;; End: ") 1583;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
1596;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp) 1584;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp)
1597 1585
1586(defun byte-recompile-file (bytecomp-filename &optional bytecomp-force bytecomp-arg load)
1587 "Recompile BYTECOMP-FILENAME file if it needs recompilation.
1588This happens when its `.elc' file is older than itself.
1589
1590If the `.elc' file exists and is up-to-date, normally this
1591function *does not* compile BYTECOMP-FILENAME. However, if the
1592prefix argument BYTECOMP-FORCE is set, that means do compile
1593BYTECOMP-FILENAME even if the destination already exists and is
1594up-to-date.
1595
1596If the `.elc' file does not exist, normally this function *does
1597not* compile BYTECOMP-FILENAME. If BYTECOMP-ARG is 0, that means
1598compile the file even if it has never been compiled before.
1599A nonzero BYTECOMP-ARG means ask the user.
1600
1601If LOAD is set, `load' the file after compiling.
1602
1603The value returned is the value returned by `byte-compile-file',
1604or 'no-byte-compile if the file did not need recompilation."
1605 (interactive
1606 (let ((bytecomp-file buffer-file-name)
1607 (bytecomp-file-name nil)
1608 (bytecomp-file-dir nil))
1609 (and bytecomp-file
1610 (eq (cdr (assq 'major-mode (buffer-local-variables)))
1611 'emacs-lisp-mode)
1612 (setq bytecomp-file-name (file-name-nondirectory bytecomp-file)
1613 bytecomp-file-dir (file-name-directory bytecomp-file)))
1614 (list (read-file-name (if current-prefix-arg
1615 "Byte compile file: "
1616 "Byte recompile file: ")
1617 bytecomp-file-dir bytecomp-file-name nil)
1618 current-prefix-arg)))
1619 (let ((bytecomp-dest
1620 (byte-compile-dest-file bytecomp-filename))
1621 ;; Expand now so we get the current buffer's defaults
1622 (bytecomp-filename (expand-file-name bytecomp-filename)))
1623 (if (if (file-exists-p bytecomp-dest)
1624 ;; File was already compiled
1625 ;; Compile if forced to, or filename newer
1626 (or bytecomp-force
1627 (file-newer-than-file-p bytecomp-filename
1628 bytecomp-dest))
1629 (or (eq 0 bytecomp-arg)
1630 (y-or-n-p (concat "Compile "
1631 bytecomp-filename "? "))))
1632 (progn
1633 (if (and noninteractive (not byte-compile-verbose))
1634 (message "Compiling %s..." bytecomp-filename))
1635 (byte-compile-file bytecomp-filename load))
1636 (when load (load bytecomp-filename))
1637 'no-byte-compile)))
1638
1598;;;###autoload 1639;;;###autoload
1599(defun byte-compile-file (bytecomp-filename &optional load) 1640(defun byte-compile-file (bytecomp-filename &optional load)
1600 "Compile a file of Lisp code named BYTECOMP-FILENAME into a file of byte code. 1641 "Compile a file of Lisp code named BYTECOMP-FILENAME into a file of byte code.
@@ -4308,5 +4349,4 @@ and corresponding effects."
4308 4349
4309(run-hooks 'bytecomp-load-hook) 4350(run-hooks 'bytecomp-load-hook)
4310 4351
4311;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a
4312;;; bytecomp.el ends here 4352;;; bytecomp.el ends here
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index e11572dfc62..9a703c96378 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -119,7 +119,8 @@ BODY contains code to execute each time the mode is enabled or disabled.
119 of the variable MODE to store the state of the mode. PLACE 119 of the variable MODE to store the state of the mode. PLACE
120 can also be of the form (GET . SET) where GET is an expression 120 can also be of the form (GET . SET) where GET is an expression
121 that returns the current state and SET is a function that takes 121 that returns the current state and SET is a function that takes
122 a new state and sets it. 122 a new state and sets it. If you specify a :variable, this
123 function assumes it is defined elsewhere.
123 124
124For example, you could write 125For example, you could write
125 (define-minor-mode foo-mode \"If enabled, foo on you!\" 126 (define-minor-mode foo-mode \"If enabled, foo on you!\"
@@ -196,6 +197,7 @@ For example, you could write
196 `(:group ',(intern (replace-regexp-in-string 197 `(:group ',(intern (replace-regexp-in-string
197 "-mode\\'" "" mode-name))))) 198 "-mode\\'" "" mode-name)))))
198 199
200 ;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode.
199 (unless type (setq type '(:type 'boolean))) 201 (unless type (setq type '(:type 'boolean)))
200 202
201 `(progn 203 `(progn
@@ -583,5 +585,4 @@ BODY is executed after moving to the destination location."
583 585
584(provide 'easy-mmode) 586(provide 'easy-mmode)
585 587
586;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a
587;;; easy-mmode.el ends here 588;;; easy-mmode.el ends here
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index e4330e43fc9..ef639d6ec37 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -407,10 +407,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
407 (if (and (buffer-modified-p) 407 (if (and (buffer-modified-p)
408 (y-or-n-p (format "Save buffer %s first? " (buffer-name)))) 408 (y-or-n-p (format "Save buffer %s first? " (buffer-name))))
409 (save-buffer)) 409 (save-buffer))
410 (let ((compiled-file-name (byte-compile-dest-file buffer-file-name))) 410 (byte-recompile-file buffer-file-name nil 0 t))
411 (if (file-newer-than-file-p compiled-file-name buffer-file-name)
412 (load-file compiled-file-name)
413 (byte-compile-file buffer-file-name t))))
414 411
415(defcustom emacs-lisp-mode-hook nil 412(defcustom emacs-lisp-mode-hook nil
416 "Hook run when entering Emacs Lisp mode." 413 "Hook run when entering Emacs Lisp mode."
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ea4c14e7cda..454036018be 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1037,10 +1037,13 @@ The variable `package-load-list' controls which packages to load."
1037(defun describe-package (package) 1037(defun describe-package (package)
1038 "Display the full documentation of PACKAGE (a symbol)." 1038 "Display the full documentation of PACKAGE (a symbol)."
1039 (interactive 1039 (interactive
1040 (let* ((packages (append (mapcar 'car package-alist) 1040 (let* ((guess (function-called-at-point))
1041 packages val)
1042 ;; Initialize the package system if it's not.
1043 (unless package-alist
1044 (package-initialize))
1045 (setq packages (append (mapcar 'car package-alist)
1041 (mapcar 'car package-archive-contents))) 1046 (mapcar 'car package-archive-contents)))
1042 (guess (function-called-at-point))
1043 val)
1044 (unless (memq guess packages) 1047 (unless (memq guess packages)
1045 (setq guess nil)) 1048 (setq guess nil))
1046 (setq packages (mapcar 'symbol-name packages)) 1049 (setq packages (mapcar 'symbol-name packages))
@@ -1617,6 +1620,9 @@ list; the default is to display everything in `package-alist'."
1617Fetches the updated list of packages before displaying. 1620Fetches the updated list of packages before displaying.
1618The list is displayed in a buffer named `*Packages*'." 1621The list is displayed in a buffer named `*Packages*'."
1619 (interactive) 1622 (interactive)
1623 ;; Initialize the package system if necessary.
1624 (unless package-alist
1625 (package-initialize))
1620 (package-refresh-contents) 1626 (package-refresh-contents)
1621 (package--list-packages)) 1627 (package--list-packages))
1622 1628
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index b922e0b0233..90f2bf411b5 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -25,6 +25,16 @@
25;; ML-style pattern matching. 25;; ML-style pattern matching.
26;; The entry points are autoloaded. 26;; The entry points are autoloaded.
27 27
28;; Todo:
29
30;; - provide ways to extend the set of primitives, with some kind of
31;; define-pcase-matcher. We could easily make it so that (guard BOOLEXP)
32;; could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)).
33;; But better would be if we could define new ways to match by having the
34;; extension provide its own `pcase-split-<foo>' thingy.
35;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to
36;; generate a lex-style DFA to decide whether to run E1 or E2.
37
28;;; Code: 38;;; Code:
29 39
30(eval-when-compile (require 'cl)) 40(eval-when-compile (require 'cl))
@@ -48,10 +58,12 @@ UPatterns can take the following forms:
48 (and UPAT...) matches if all the patterns match. 58 (and UPAT...) matches if all the patterns match.
49 `QPAT matches if the QPattern QPAT matches. 59 `QPAT matches if the QPattern QPAT matches.
50 (pred PRED) matches if PRED applied to the object returns non-nil. 60 (pred PRED) matches if PRED applied to the object returns non-nil.
61 (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
51 62
52QPatterns can take the following forms: 63QPatterns can take the following forms:
53 (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. 64 (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
54 ,UPAT matches if the UPattern UPAT matches. 65 ,UPAT matches if the UPattern UPAT matches.
66 STRING matches if the object is `equal' to STRING.
55 ATOM matches if the object is `eq' to ATOM. 67 ATOM matches if the object is `eq' to ATOM.
56QPatterns for vectors are not implemented yet. 68QPatterns for vectors are not implemented yet.
57 69
@@ -77,6 +89,8 @@ of the form (UPAT EXP)."
77 (if (null bindings) body 89 (if (null bindings) body
78 `(pcase ,(cadr (car bindings)) 90 `(pcase ,(cadr (car bindings))
79 (,(caar bindings) (pcase-let* ,(cdr bindings) ,body)) 91 (,(caar bindings) (pcase-let* ,(cdr bindings) ,body))
92 ;; FIXME: In many cases `dontcare' would be preferable, so maybe we
93 ;; should have `let' and `elet', like we have `case' and `ecase'.
80 (t (error "Pattern match failure in `pcase-let'"))))) 94 (t (error "Pattern match failure in `pcase-let'")))))
81 95
82;;;###autoload 96;;;###autoload
@@ -167,12 +181,19 @@ of the form (UPAT EXP)."
167 (cond 181 (cond
168 ((eq else :pcase-dontcare) then) 182 ((eq else :pcase-dontcare) then)
169 ((eq (car-safe else) 'if) 183 ((eq (car-safe else) 'if)
170 `(cond (,test ,then) 184 (if (equal test (nth 1 else))
171 (,(nth 1 else) ,(nth 2 else)) 185 ;; Doing a test a second time: get rid of the redundancy.
172 (t ,@(nthcdr 3 else)))) 186 ;; FIXME: ideally, this should never happen because the pcase-split-*
187 ;; functions should have eliminated such things, but pcase-split-member
188 ;; is imprecise, so in practice it does happen occasionally.
189 `(if ,test ,then ,@(nthcdr 3 else))
190 `(cond (,test ,then)
191 (,(nth 1 else) ,(nth 2 else))
192 (t ,@(nthcdr 3 else)))))
173 ((eq (car-safe else) 'cond) 193 ((eq (car-safe else) 'cond)
174 `(cond (,test ,then) 194 `(cond (,test ,then)
175 ,@(cdr else))) 195 ;; Doing a test a second time: get rid of the redundancy, as above.
196 ,@(remove (assoc test else) (cdr else))))
176 (t `(if ,test ,then ,else)))) 197 (t `(if ,test ,then ,else))))
177 198
178(defun pcase-upat (qpattern) 199(defun pcase-upat (qpattern)
@@ -276,7 +297,7 @@ MATCH is the pattern that needs to be matched, of the form:
276 ;; A QPattern but not for a cons, can only go the `else' side. 297 ;; A QPattern but not for a cons, can only go the `else' side.
277 ((eq (car-safe pat) '\`) (cons :pcase-fail nil)))) 298 ((eq (car-safe pat) '\`) (cons :pcase-fail nil))))
278 299
279(defun pcase-split-eq (elem pat) 300(defun pcase-split-equal (elem pat)
280 (cond 301 (cond
281 ;; The same match will give the same result. 302 ;; The same match will give the same result.
282 ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem)) 303 ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem))
@@ -288,11 +309,11 @@ MATCH is the pattern that needs to be matched, of the form:
288 ) 309 )
289 (cons :pcase-fail nil)))) 310 (cons :pcase-fail nil))))
290 311
291(defun pcase-split-memq (elems pat) 312(defun pcase-split-member (elems pat)
292 ;; Based on pcase-split-eq. 313 ;; Based on pcase-split-equal.
293 (cond 314 (cond
294 ;; The same match will give the same result, but we don't know how 315 ;; The same match (or a match of membership in a superset) will
295 ;; to check it. 316 ;; give the same result, but we don't know how to check it.
296 ;; (??? 317 ;; (???
297 ;; (cons :pcase-succeed nil)) 318 ;; (cons :pcase-succeed nil))
298 ;; A match for one of the elements may succeed or fail. 319 ;; A match for one of the elements may succeed or fail.
@@ -347,7 +368,8 @@ and otherwise defers to REST which is a list of branches of the form
347 (if (and (eq (car alt) 'match) (eq var (cadr alt)) 368 (if (and (eq (car alt) 'match) (eq var (cadr alt))
348 (let ((upat (cddr alt))) 369 (let ((upat (cddr alt)))
349 (and (eq (car-safe upat) '\`) 370 (and (eq (car-safe upat) '\`)
350 (or (integerp (cadr upat)) (symbolp (cadr upat)))))) 371 (or (integerp (cadr upat)) (symbolp (cadr upat))
372 (stringp (cadr upat))))))
351 (push (cddr alt) simples) 373 (push (cddr alt) simples)
352 (push alt others)))) 374 (push alt others))))
353 (cond 375 (cond
@@ -380,17 +402,19 @@ and otherwise defers to REST which is a list of branches of the form
380 ((memq upat '(t _)) (pcase-u1 matches code vars rest)) 402 ((memq upat '(t _)) (pcase-u1 matches code vars rest))
381 ((eq upat 'dontcare) :pcase-dontcare) 403 ((eq upat 'dontcare) :pcase-dontcare)
382 ((functionp upat) (error "Feature removed, use (pred %s)" upat)) 404 ((functionp upat) (error "Feature removed, use (pred %s)" upat))
383 ((eq (car-safe upat) 'pred) 405 ((memq (car-safe upat) '(guard pred))
384 (destructuring-bind (then-rest &rest else-rest) 406 (destructuring-bind (then-rest &rest else-rest)
385 (pcase-split-rest 407 (pcase-split-rest
386 sym (apply-partially 'pcase-split-pred upat) rest) 408 sym (apply-partially 'pcase-split-pred upat) rest)
387 (pcase-if (if (symbolp (cadr upat)) 409 (pcase-if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))
388 `(,(cadr upat) ,sym) 410 `(,(cadr upat) ,sym)
389 (let* ((exp (cadr upat)) 411 (let* ((exp (cadr upat))
390 ;; `vs' is an upper bound on the vars we need. 412 ;; `vs' is an upper bound on the vars we need.
391 (vs (pcase-fgrep (mapcar #'car vars) exp)) 413 (vs (pcase-fgrep (mapcar #'car vars) exp))
392 (call (if (functionp exp) 414 (call (cond
393 `(,exp ,sym) `(,@exp ,sym)))) 415 ((eq 'guard (car upat)) exp)
416 ((functionp exp) `(,exp ,sym))
417 (t `(,@exp ,sym)))))
394 (if (null vs) 418 (if (null vs)
395 call 419 call
396 ;; Let's not replace `vars' in `exp' since it's 420 ;; Let's not replace `vars' in `exp' since it's
@@ -409,19 +433,22 @@ and otherwise defers to REST which is a list of branches of the form
409 ((eq (car-safe upat) '\`) 433 ((eq (car-safe upat) '\`)
410 (pcase-q1 sym (cadr upat) matches code vars rest)) 434 (pcase-q1 sym (cadr upat) matches code vars rest))
411 ((eq (car-safe upat) 'or) 435 ((eq (car-safe upat) 'or)
412 (let ((all (> (length (cdr upat)) 1))) 436 (let ((all (> (length (cdr upat)) 1))
437 (memq-fine t))
413 (when all 438 (when all
414 (dolist (alt (cdr upat)) 439 (dolist (alt (cdr upat))
415 (unless (and (eq (car-safe alt) '\`) 440 (unless (and (eq (car-safe alt) '\`)
416 (or (symbolp (cadr alt)) (integerp (cadr alt)))) 441 (or (symbolp (cadr alt)) (integerp (cadr alt))
442 (setq memq-fine nil)
443 (stringp (cadr alt))))
417 (setq all nil)))) 444 (setq all nil))))
418 (if all 445 (if all
419 ;; Use memq for (or `a `b `c `d) rather than a big tree. 446 ;; Use memq for (or `a `b `c `d) rather than a big tree.
420 (let ((elems (mapcar 'cadr (cdr upat)))) 447 (let ((elems (mapcar 'cadr (cdr upat))))
421 (destructuring-bind (then-rest &rest else-rest) 448 (destructuring-bind (then-rest &rest else-rest)
422 (pcase-split-rest 449 (pcase-split-rest
423 sym (apply-partially 'pcase-split-memq elems) rest) 450 sym (apply-partially 'pcase-split-member elems) rest)
424 (pcase-if `(memq ,sym ',elems) 451 (pcase-if `(,(if memq-fine #'memq #'member) ,sym ',elems)
425 (pcase-u1 matches code vars then-rest) 452 (pcase-u1 matches code vars then-rest)
426 (pcase-u else-rest)))) 453 (pcase-u else-rest))))
427 (pcase-u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars 454 (pcase-u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars
@@ -483,10 +510,10 @@ and if not, defers to REST which is a list of branches of the form
483 ,@matches) 510 ,@matches)
484 code vars then-rest)) 511 code vars then-rest))
485 (pcase-u else-rest))))) 512 (pcase-u else-rest)))))
486 ((or (integerp qpat) (symbolp qpat)) 513 ((or (integerp qpat) (symbolp qpat) (stringp qpat))
487 (destructuring-bind (then-rest &rest else-rest) 514 (destructuring-bind (then-rest &rest else-rest)
488 (pcase-split-rest sym (apply-partially 'pcase-split-eq qpat) rest) 515 (pcase-split-rest sym (apply-partially 'pcase-split-equal qpat) rest)
489 (pcase-if `(eq ,sym ',qpat) 516 (pcase-if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat)
490 (pcase-u1 matches code vars then-rest) 517 (pcase-u1 matches code vars then-rest)
491 (pcase-u else-rest)))) 518 (pcase-u else-rest))))
492 (t (error "Unkown QPattern %s" qpat)))) 519 (t (error "Unkown QPattern %s" qpat))))
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 4f5b2046150..afb2834414a 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -70,6 +70,10 @@
70 70
71(eval-when-compile (require 'cl)) 71(eval-when-compile (require 'cl))
72 72
73(defgroup smie nil
74 "Simple Minded Indentation Engine."
75 :group 'languages)
76
73(defvar comment-continue) 77(defvar comment-continue)
74(declare-function comment-string-strip "newcomment" (str beforep afterp)) 78(declare-function comment-string-strip "newcomment" (str beforep afterp))
75 79
@@ -109,6 +113,7 @@
109 (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))) 113 (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)))
110 (puthash key val table)))) 114 (puthash key val table))))
111 115
116(put 'smie-precs-precedence-table 'pure t)
112(defun smie-precs-precedence-table (precs) 117(defun smie-precs-precedence-table (precs)
113 "Compute a 2D precedence table from a list of precedences. 118 "Compute a 2D precedence table from a list of precedences.
114PRECS should be a list, sorted by precedence (e.g. \"+\" will 119PRECS should be a list, sorted by precedence (e.g. \"+\" will
@@ -132,6 +137,7 @@ one of those elements share the same precedence level and associativity."
132 (smie-set-prec2tab prec2-table other-op op op1))))))) 137 (smie-set-prec2tab prec2-table other-op op op1)))))))
133 prec2-table)) 138 prec2-table))
134 139
140(put 'smie-merge-prec2s 'pure t)
135(defun smie-merge-prec2s (&rest tables) 141(defun smie-merge-prec2s (&rest tables)
136 (if (null (cdr tables)) 142 (if (null (cdr tables))
137 (car tables) 143 (car tables)
@@ -147,6 +153,7 @@ one of those elements share the same precedence level and associativity."
147 table)) 153 table))
148 prec2))) 154 prec2)))
149 155
156(put 'smie-bnf-precedence-table 'pure t)
150(defun smie-bnf-precedence-table (bnf &rest precs) 157(defun smie-bnf-precedence-table (bnf &rest precs)
151 (let ((nts (mapcar 'car bnf)) ;Non-terminals 158 (let ((nts (mapcar 'car bnf)) ;Non-terminals
152 (first-ops-table ()) 159 (first-ops-table ())
@@ -233,6 +240,7 @@ one of those elements share the same precedence level and associativity."
233 ;; Keep track of which tokens are openers/closer, so they can get a nil 240 ;; Keep track of which tokens are openers/closer, so they can get a nil
234 ;; precedence in smie-prec2-levels. 241 ;; precedence in smie-prec2-levels.
235 (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2) 242 (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2)
243 (puthash :smie-closer-alist (smie-bnf-closer-alist bnf) prec2)
236 prec2)) 244 prec2))
237 245
238;; (defun smie-prec2-closer-alist (prec2 include-inners) 246;; (defun smie-prec2-closer-alist (prec2 include-inners)
@@ -377,6 +385,7 @@ CSTS is a list of pairs representing arcs in a graph."
377 (append names (list (car names))) 385 (append names (list (car names)))
378 " < "))) 386 " < ")))
379 387
388(put 'smie-prec2-levels 'pure t)
380(defun smie-prec2-levels (prec2) 389(defun smie-prec2-levels (prec2)
381 ;; FIXME: Rather than only return an alist of precedence levels, we should 390 ;; FIXME: Rather than only return an alist of precedence levels, we should
382 ;; also extract other useful data from it: 391 ;; also extract other useful data from it:
@@ -479,6 +488,8 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or
479 (eq 'closer (cdr (assoc (car x) classification-table)))) 488 (eq 'closer (cdr (assoc (car x) classification-table))))
480 (setf (nth 2 x) i) 489 (setf (nth 2 x) i)
481 (incf i))))) ;See other (incf i) above. 490 (incf i))))) ;See other (incf i) above.
491 (let ((ca (gethash :smie-closer-alist prec2)))
492 (when ca (push (cons :smie-closer-alist ca) table)))
482 table)) 493 table))
483 494
484;;; Parsing using a precedence level table. 495;;; Parsing using a precedence level table.
@@ -783,7 +794,8 @@ I.e. a good choice can be:
783(defcustom smie-blink-matching-inners t 794(defcustom smie-blink-matching-inners t
784 "Whether SMIE should blink to matching opener for inner keywords. 795 "Whether SMIE should blink to matching opener for inner keywords.
785If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." 796If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"."
786 :type 'boolean) 797 :type 'boolean
798 :group 'smie)
787 799
788(defun smie-blink-matching-check (start end) 800(defun smie-blink-matching-check (start end)
789 (save-excursion 801 (save-excursion
@@ -803,14 +815,22 @@ If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"
803(defun smie-blink-matching-open () 815(defun smie-blink-matching-open ()
804 "Blink the matching opener when applicable. 816 "Blink the matching opener when applicable.
805This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'." 817This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'."
818 (let ((pos (point)) ;Position after the close token.
819 token)
806 (when (and blink-matching-paren 820 (when (and blink-matching-paren
807 smie-closer-alist ; Optimization. 821 smie-closer-alist ; Optimization.
808 (eq (char-before) last-command-event) ; Sanity check. 822 (or (eq (char-before) last-command-event) ;; Sanity check.
823 (save-excursion
824 (or (progn (skip-chars-backward " \t")
825 (setq pos (point))
826 (eq (char-before) last-command-event))
827 (progn (skip-chars-backward " \n\t")
828 (setq pos (point))
829 (eq (char-before) last-command-event)))))
809 (memq last-command-event smie-blink-matching-triggers) 830 (memq last-command-event smie-blink-matching-triggers)
810 (not (nth 8 (syntax-ppss)))) 831 (not (nth 8 (syntax-ppss))))
811 (save-excursion 832 (save-excursion
812 (let ((pos (point)) 833 (setq token (funcall smie-backward-token-function))
813 (token (funcall smie-backward-token-function)))
814 (when (and (eq (point) (1- pos)) 834 (when (and (eq (point) (1- pos))
815 (= 1 (length token)) 835 (= 1 (length token))
816 (not (rassoc token smie-closer-alist))) 836 (not (rassoc token smie-closer-alist)))
@@ -818,17 +838,20 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'.
818 ;; closers (e.g. ?\; in Octave mode), so go back to the 838 ;; closers (e.g. ?\; in Octave mode), so go back to the
819 ;; previous token. 839 ;; previous token.
820 (setq pos (point)) 840 (setq pos (point))
821 (setq token (save-excursion 841 (setq token (funcall smie-backward-token-function)))
822 (funcall smie-backward-token-function))))
823 (when (rassoc token smie-closer-alist) 842 (when (rassoc token smie-closer-alist)
824 ;; We're after a close token. Let's still make sure we 843 ;; We're after a close token. Let's still make sure we
825 ;; didn't skip a comment to find that token. 844 ;; didn't skip a comment to find that token.
826 (funcall smie-forward-token-function) 845 (funcall smie-forward-token-function)
827 (when (and (save-excursion 846 (when (and (save-excursion
828 ;; Trigger can be SPC, or reindent. 847 ;; Skip the trigger char, if applicable.
829 (skip-chars-forward " \n\t") 848 (if (eq (char-after) last-command-event)
849 (forward-char 1))
850 (if (eq ?\n last-command-event)
851 ;; Skip any auto-indentation, if applicable.
852 (skip-chars-forward " \t"))
830 (>= (point) pos)) 853 (>= (point) pos))
831 ;; If token ends with a trigger char, so don't blink for 854 ;; If token ends with a trigger char, don't blink for
832 ;; anything else than this trigger char, lest we'd blink 855 ;; anything else than this trigger char, lest we'd blink
833 ;; both when inserting the trigger char and when 856 ;; both when inserting the trigger char and when
834 ;; inserting a subsequent trigger char like SPC. 857 ;; inserting a subsequent trigger char like SPC.
@@ -848,36 +871,28 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'.
848 871
849(defcustom smie-indent-basic 4 872(defcustom smie-indent-basic 4
850 "Basic amount of indentation." 873 "Basic amount of indentation."
851 :type 'integer) 874 :type 'integer
852 875 :group 'smie)
853(defvar smie-indent-rules 'unset 876
854 ;; TODO: For SML, we need more rule formats, so as to handle 877(defvar smie-rules-function 'ignore
855 ;; structure Foo = 878 "Function providing the indentation rules.
856 ;; Bar (toto) 879It takes two arguments METHOD and ARG where the meaning of ARG
857 ;; and 880and the expected return value depends on METHOD.
858 ;; structure Foo = 881METHOD can be:
859 ;; struct ... end 882- :after, in which case ARG is a token and the function should return the
860 ;; I.e. the indentation after "=" depends on the parent ("structure") 883 OFFSET to use for indentation after ARG.
861 ;; as well as on the following token ("struct"). 884- :before, in which case ARG is a token and the function should return the
862 "Rules of the following form. 885 OFFSET to use to indent ARG itself.
863\((:before . TOK) . OFFSET-RULES) how to indent TOK itself. 886- :elem, in which case the function should return either:
864\(TOK . OFFSET-RULES) how to indent right after TOK. 887 - the offset to use to indent function arguments (ARG = `arg')
865\(list-intro . TOKENS) declare TOKENS as being followed by what may look like 888 - the basic indentation step (ARG = `basic').
866 a funcall but is just a sequence of expressions. 889- :list-intro, in which case ARG is a token and the function should return
867\(t . OFFSET) basic indentation step. 890 non-nil if TOKEN is followed by a list of expressions (not separated by any
868\(args . OFFSET) indentation of arguments. 891 token) rather than an expression.
869\((T1 . T2) OFFSET) like ((:before . T2) (:parent T1 OFFSET)). 892
870 893When ARG is a token, the function is called with point just before that token.
871OFFSET-RULES is a list of elements which can each either be: 894A return value of nil always means to fallback on the default behavior, so the
872 895function should return nil for arguments it does not expect.
873\(:hanging . OFFSET-RULES) if TOK is hanging, use OFFSET-RULES.
874\(:parent PARENT . OFFSET-RULES) if TOK's parent is PARENT, use OFFSET-RULES.
875\(:next TOKEN . OFFSET-RULES) if TOK is followed by TOKEN, use OFFSET-RULES.
876\(:prev TOKEN . OFFSET-RULES) if TOK is preceded by TOKEN, use
877\(:bolp . OFFSET-RULES) If TOK is first on a line, use OFFSET-RULES.
878OFFSET the offset to use.
879
880PARENT can be either the name of the parent or a list of such names.
881 896
882OFFSET can be of the form: 897OFFSET can be of the form:
883`point' align with the token. 898`point' align with the token.
@@ -886,91 +901,69 @@ NUMBER offset by NUMBER.
886\(+ OFFSETS...) use the sum of OFFSETS. 901\(+ OFFSETS...) use the sum of OFFSETS.
887VARIABLE use the value of VARIABLE as offset. 902VARIABLE use the value of VARIABLE as offset.
888 903
889The precise meaning of `point' depends on various details: it can 904This function will often use some of the following functions designed
890either mean the position of the token we're indenting, or the 905specifically for it:
891position of its parent, or the position right after its parent. 906`smie-bolp', `smie-hanging-p', `smie-parent-p', `smie-next-p', `smie-prev-p'.")
892
893A nil offset for indentation after an opening token defaults
894to `smie-indent-basic'.")
895 907
896(defun smie-indent--hanging-p () 908(defun smie-hanging-p ()
897 ;; A hanging keyword is one that's at the end of a line except it's not at 909 "Return non-nil if the current token is \"hanging\".
898 ;; the beginning of a line. 910A hanging keyword is one that's at the end of a line except it's not at
899 (and (save-excursion 911the beginning of a line."
912 (and (not (smie-bolp))
913 (save-excursion
900 (when (zerop (length (funcall smie-forward-token-function))) 914 (when (zerop (length (funcall smie-forward-token-function)))
901 ;; Could be an open-paren. 915 ;; Could be an open-paren.
902 (forward-char 1)) 916 (forward-char 1))
903 (skip-chars-forward " \t") 917 (skip-chars-forward " \t")
904 (eolp)) 918 (eolp))))
905 (not (smie-indent--bolp))))
906 919
907(defun smie-indent--bolp () 920(defun smie-bolp ()
921 "Return non-nil if the current token is the first on the line."
908 (save-excursion (skip-chars-backward " \t") (bolp))) 922 (save-excursion (skip-chars-backward " \t") (bolp)))
909 923
924(defvar smie--parent) (defvar smie--after) ;Dynamically scoped.
925
926(defun smie-parent-p (&rest parents)
927 "Return non-nil if the current token's parent is among PARENTS.
928Only meaningful when called from within `smie-rules-function'."
929 (member (nth 2 (or smie--parent
930 (save-excursion
931 (let* ((pos (point))
932 (tok (funcall smie-forward-token-function)))
933 (unless (cadr (assoc tok smie-op-levels))
934 (goto-char pos))
935 (setq smie--parent
936 (smie-backward-sexp 'halfsexp))))))
937 parents))
938
939(defun smie-next-p (&rest tokens)
940 "Return non-nil if the next token is among TOKENS.
941Only meaningful when called from within `smie-rules-function'."
942 (let ((next
943 (save-excursion
944 (unless smie--after
945 (smie-indent-forward-token) (setq smie--after (point)))
946 (goto-char smie--after)
947 (smie-indent-forward-token))))
948 (member (car next) tokens)))
949
950(defun smie-prev-p (&rest tokens)
951 "Return non-nil if the previous token is among TOKENS."
952 (let ((prev (save-excursion
953 (smie-indent-backward-token))))
954 (member (car prev) tokens)))
955
956
910(defun smie-indent--offset (elem) 957(defun smie-indent--offset (elem)
911 (or (cdr (assq elem smie-indent-rules)) 958 (or (funcall smie-rules-function :elem elem)
912 (cdr (assq t smie-indent-rules)) 959 (if (not (eq elem 'basic))
960 (funcall smie-rules-function :elem 'basic))
913 smie-indent-basic)) 961 smie-indent-basic))
914 962
915(defvar smie-indent-debug-log) 963(defun smie-indent--rule (kind token &optional after parent)
916 964 (let ((smie--parent parent)
917(defun smie-indent--offset-rule (tokinfo &optional after parent) 965 (smie--after after))
918 "Apply the OFFSET-RULES in TOKINFO. 966 (funcall smie-rules-function kind token)))
919Point is expected to be right in front of the token corresponding to TOKINFO.
920If computing the indentation after the token, then AFTER is the position
921after the token, otherwise it should be nil.
922PARENT if non-nil should be the parent info returned by `smie-backward-sexp'."
923 (let ((rules (cdr tokinfo))
924 next prev
925 offset)
926 (while (consp rules)
927 (let ((rule (pop rules)))
928 (cond
929 ((not (consp rule)) (setq offset rule))
930 ((eq (car rule) '+) (setq offset rule))
931 ((eq (car rule) :hanging)
932 (when (smie-indent--hanging-p)
933 (setq rules (cdr rule))))
934 ((eq (car rule) :bolp)
935 (when (smie-indent--bolp)
936 (setq rules (cdr rule))))
937 ((eq (car rule) :eolp)
938 (unless after
939 (error "Can't use :eolp in :before indentation rules"))
940 (when (> after (line-end-position))
941 (setq rules (cdr rule))))
942 ((eq (car rule) :prev)
943 (unless prev
944 (save-excursion
945 (setq prev (smie-indent-backward-token))))
946 (when (equal (car prev) (cadr rule))
947 (setq rules (cddr rule))))
948 ((eq (car rule) :next)
949 (unless next
950 (unless after
951 (error "Can't use :next in :before indentation rules"))
952 (save-excursion
953 (goto-char after)
954 (setq next (smie-indent-forward-token))))
955 (when (equal (car next) (cadr rule))
956 (setq rules (cddr rule))))
957 ((eq (car rule) :parent)
958 (unless parent
959 (save-excursion
960 (if after (goto-char after))
961 (setq parent (smie-backward-sexp 'halfsexp))))
962 (when (if (listp (cadr rule))
963 (member (nth 2 parent) (cadr rule))
964 (equal (nth 2 parent) (cadr rule)))
965 (setq rules (cddr rule))))
966 (t (error "Unknown rule %s for indentation of %s"
967 rule (car tokinfo))))))
968 ;; If `offset' is not set yet, use `rules' to handle the case where
969 ;; the tokinfo uses the old-style ((PARENT . TOK). OFFSET).
970 (unless offset (setq offset rules))
971 (when (boundp 'smie-indent-debug-log)
972 (push (list (point) offset tokinfo) smie-indent-debug-log))
973 offset))
974 967
975(defun smie-indent--column (offset &optional base parent virtual-point) 968(defun smie-indent--column (offset &optional base parent virtual-point)
976 "Compute the actual column to use for a given OFFSET. 969 "Compute the actual column to use for a given OFFSET.
@@ -1012,6 +1005,9 @@ If VIRTUAL-POINT is non-nil, then `point' is virtual."
1012 (if (consp parent) (goto-char (cadr parent))) 1005 (if (consp parent) (goto-char (cadr parent)))
1013 (smie-indent-virtual)) 1006 (smie-indent-virtual))
1014 ((eq offset nil) nil) 1007 ((eq offset nil) nil)
1008 ;; FIXME: would be good to get rid of this since smie-rules-function
1009 ;; can usually do the lookup trivially, but in cases where
1010 ;; smie-rules-function returns (+ point VAR) it's not nearly as trivial.
1015 ((and (symbolp offset) (boundp 'offset)) 1011 ((and (symbolp offset) (boundp 'offset))
1016 (smie-indent--column (symbol-value offset) base parent virtual-point)) 1012 (smie-indent--column (symbol-value offset) base parent virtual-point))
1017 (t (error "Unknown indentation offset %s" offset)))) 1013 (t (error "Unknown indentation offset %s" offset))))
@@ -1046,11 +1042,11 @@ This is used when we're not trying to indent point but just
1046need to compute the column at which point should be indented 1042need to compute the column at which point should be indented
1047in order to figure out the indentation of some other (further down) point." 1043in order to figure out the indentation of some other (further down) point."
1048 ;; Trust pre-existing indentation on other lines. 1044 ;; Trust pre-existing indentation on other lines.
1049 (if (smie-indent--bolp) (current-column) (smie-indent-calculate))) 1045 (if (smie-bolp) (current-column) (smie-indent-calculate)))
1050 1046
1051(defun smie-indent-fixindent () 1047(defun smie-indent-fixindent ()
1052 ;; Obey the `fixindent' special comment. 1048 ;; Obey the `fixindent' special comment.
1053 (and (smie-indent--bolp) 1049 (and (smie-bolp)
1054 (save-excursion 1050 (save-excursion
1055 (comment-normalize-vars) 1051 (comment-normalize-vars)
1056 (re-search-forward (concat comment-start-skip 1052 (re-search-forward (concat comment-start-skip
@@ -1090,43 +1086,31 @@ in order to figure out the indentation of some other (further down) point."
1090 (save-excursion 1086 (save-excursion
1091 (goto-char pos) 1087 (goto-char pos)
1092 ;; Different cases: 1088 ;; Different cases:
1093 ;; - smie-indent--bolp: "indent according to others". 1089 ;; - smie-bolp: "indent according to others".
1094 ;; - common hanging: "indent according to others". 1090 ;; - common hanging: "indent according to others".
1095 ;; - SML-let hanging: "indent like parent". 1091 ;; - SML-let hanging: "indent like parent".
1096 ;; - if-after-else: "indent-like parent". 1092 ;; - if-after-else: "indent-like parent".
1097 ;; - middle-of-line: "trust current position". 1093 ;; - middle-of-line: "trust current position".
1098 (cond 1094 (cond
1099 ((null (cdr toklevels)) nil) ;Not a keyword. 1095 ((null (cdr toklevels)) nil) ;Not a keyword.
1100 ((smie-indent--bolp) 1096 ((smie-bolp)
1101 ;; For an open-paren-like thingy at BOL, always indent only 1097 ;; For an open-paren-like thingy at BOL, always indent only
1102 ;; based on other rules (typically smie-indent-after-keyword). 1098 ;; based on other rules (typically smie-indent-after-keyword).
1103 nil) 1099 nil)
1104 (t 1100 (t
1105 ;; We're only ever here for virtual-indent, which is why 1101 ;; We're only ever here for virtual-indent, which is why
1106 ;; we can use (current-column) as answer for `point'. 1102 ;; we can use (current-column) as answer for `point'.
1107 (let* ((tokinfo (or (assoc (cons :before token) 1103 (let* ((offset (or (smie-indent--rule :before token)
1108 smie-indent-rules)
1109 ;; By default use point unless we're hanging. 1104 ;; By default use point unless we're hanging.
1110 `((:before . ,token) (:hanging nil) point))) 1105 (unless (smie-hanging-p) 'point))))
1111 ;; (after (prog1 (point) (goto-char pos)))
1112 (offset (smie-indent--offset-rule tokinfo)))
1113 (smie-indent--column offset))))) 1106 (smie-indent--column offset)))))
1114 1107
1115 ;; FIXME: This still looks too much like black magic!! 1108 ;; FIXME: This still looks too much like black magic!!
1116 ;; FIXME: Rather than a bunch of rules like (PARENT . TOKEN), we
1117 ;; want a single rule for TOKEN with different cases for each PARENT.
1118 (let* ((parent (smie-backward-sexp 'halfsexp)) 1109 (let* ((parent (smie-backward-sexp 'halfsexp))
1119 (tokinfo
1120 (or (assoc (cons (caddr parent) token)
1121 smie-indent-rules)
1122 (assoc (cons :before token) smie-indent-rules)
1123 ;; Default rule.
1124 `((:before . ,token)
1125 ;; (:parent open 0)
1126 point)))
1127 (offset (save-excursion 1110 (offset (save-excursion
1128 (goto-char pos) 1111 (goto-char pos)
1129 (smie-indent--offset-rule tokinfo nil parent)))) 1112 (or (smie-indent--rule :before token nil parent)
1113 'point))))
1130 ;; Different behaviors: 1114 ;; Different behaviors:
1131 ;; - align with parent. 1115 ;; - align with parent.
1132 ;; - parent + offset. 1116 ;; - parent + offset.
@@ -1151,10 +1135,10 @@ in order to figure out the indentation of some other (further down) point."
1151 nil) 1135 nil)
1152 ((eq (car parent) (car toklevels)) 1136 ((eq (car parent) (car toklevels))
1153 ;; We bumped into a same-level operator. align with it. 1137 ;; We bumped into a same-level operator. align with it.
1154 (if (and (smie-indent--bolp) (/= (point) pos) 1138 (if (and (smie-bolp) (/= (point) pos)
1155 (save-excursion 1139 (save-excursion
1156 (goto-char (goto-char (cadr parent))) 1140 (goto-char (goto-char (cadr parent)))
1157 (not (smie-indent--bolp))) 1141 (not (smie-bolp)))
1158 ;; Check the offset of `token' rather then its parent 1142 ;; Check the offset of `token' rather then its parent
1159 ;; because its parent may have used a special rule. E.g. 1143 ;; because its parent may have used a special rule. E.g.
1160 ;; function foo; 1144 ;; function foo;
@@ -1190,8 +1174,8 @@ in order to figure out the indentation of some other (further down) point."
1190 ;; -> d 1174 ;; -> d
1191 ;; So as to align with the earliest appropriate place. 1175 ;; So as to align with the earliest appropriate place.
1192 (smie-indent-virtual))) 1176 (smie-indent-virtual)))
1193 (tokinfo 1177 (t
1194 (if (and (= (point) pos) (smie-indent--bolp) 1178 (if (and (= (point) pos) (smie-bolp)
1195 (or (eq offset 'point) 1179 (or (eq offset 'point)
1196 (and (consp offset) (memq 'point offset)))) 1180 (and (consp offset) (memq 'point offset))))
1197 ;; Since we started at BOL, we're not computing a virtual 1181 ;; Since we started at BOL, we're not computing a virtual
@@ -1209,7 +1193,7 @@ in order to figure out the indentation of some other (further down) point."
1209 ;; Don't do it for virtual indentations. We should normally never be "in 1193 ;; Don't do it for virtual indentations. We should normally never be "in
1210 ;; front of a comment" when doing virtual-indentation anyway. And if we are 1194 ;; front of a comment" when doing virtual-indentation anyway. And if we are
1211 ;; (as can happen in octave-mode), moving forward can lead to inf-loops. 1195 ;; (as can happen in octave-mode), moving forward can lead to inf-loops.
1212 (and (smie-indent--bolp) 1196 (and (smie-bolp)
1213 (let ((pos (point))) 1197 (let ((pos (point)))
1214 (save-excursion 1198 (save-excursion
1215 (beginning-of-line) 1199 (beginning-of-line)
@@ -1254,27 +1238,18 @@ in order to figure out the indentation of some other (further down) point."
1254 (save-excursion 1238 (save-excursion
1255 (let* ((pos (point)) 1239 (let* ((pos (point))
1256 (toklevel (smie-indent-backward-token)) 1240 (toklevel (smie-indent-backward-token))
1257 (tok (car toklevel)) 1241 (tok (car toklevel)))
1258 (tokinfo (assoc tok smie-indent-rules)))
1259 ;; Set some default indent rules.
1260 (if (and toklevel (null (cadr toklevel)) (null tokinfo))
1261 (setq tokinfo (list (car toklevel))))
1262 ;; (if (and tokinfo (null toklevel))
1263 ;; (error "Token %S has indent rule but has no parsing info" tok))
1264 (when toklevel 1242 (when toklevel
1265 (unless tokinfo
1266 ;; The default indentation after a keyword/operator is 0 for
1267 ;; infix and t for prefix.
1268 ;; Using the BNF syntax, we could come up with better
1269 ;; defaults, but we only have the precedence levels here.
1270 (setq tokinfo (list tok 'default-rule
1271 (if (cadr toklevel) 0 (smie-indent--offset t)))))
1272 (let ((offset 1243 (let ((offset
1273 (or (smie-indent--offset-rule tokinfo pos) 1244 (or (smie-indent--rule :after tok pos)
1274 (smie-indent--offset t)))) 1245 ;; The default indentation after a keyword/operator is
1275 (let ((before (point))) 1246 ;; 0 for infix and t for prefix.
1247 (if (or (null (cadr toklevel))
1248 (rassoc tok smie-closer-alist))
1249 (smie-indent--offset 'basic) 0)))
1250 (before (point)))
1276 (goto-char pos) 1251 (goto-char pos)
1277 (smie-indent--column offset before))))))) 1252 (smie-indent--column offset before))))))
1278 1253
1279(defun smie-indent-exps () 1254(defun smie-indent-exps ()
1280 ;; Indentation of sequences of simple expressions without 1255 ;; Indentation of sequences of simple expressions without
@@ -1297,13 +1272,14 @@ in order to figure out the indentation of some other (further down) point."
1297 arg) 1272 arg)
1298 (while (and (null (car (smie-backward-sexp))) 1273 (while (and (null (car (smie-backward-sexp)))
1299 (push (point) positions) 1274 (push (point) positions)
1300 (not (smie-indent--bolp)))) 1275 (not (smie-bolp))))
1301 (save-excursion 1276 (save-excursion
1302 ;; Figure out if the atom we just skipped is an argument rather 1277 ;; Figure out if the atom we just skipped is an argument rather
1303 ;; than a function. 1278 ;; than a function.
1304 (setq arg (or (null (car (smie-backward-sexp))) 1279 (setq arg
1305 (member (funcall smie-backward-token-function) 1280 (or (null (car (smie-backward-sexp)))
1306 (cdr (assoc 'list-intro smie-indent-rules)))))) 1281 (funcall smie-rules-function :list-intro
1282 (funcall smie-backward-token-function)))))
1307 (cond 1283 (cond
1308 ((null positions) 1284 ((null positions)
1309 ;; We're the first expression of the list. In that case, the 1285 ;; We're the first expression of the list. In that case, the
@@ -1362,18 +1338,51 @@ to which that point should be aligned, if we were to reindent it.")
1362 (save-excursion (indent-line-to indent)) 1338 (save-excursion (indent-line-to indent))
1363 (indent-line-to indent))))) 1339 (indent-line-to indent)))))
1364 1340
1365(defun smie-indent-debug () 1341(defun smie-setup (op-levels rules-function &rest keywords)
1366 "Show the rules used to compute indentation of current line." 1342 "Setup SMIE navigation and indentation.
1367 (interactive) 1343OP-LEVELS is a grammar table generated by `smie-prec2-levels'.
1368 (let ((smie-indent-debug-log '())) 1344RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'.
1369 (smie-indent-calculate) 1345KEYWORDS are additional arguments, which can use the following keywords:
1370 ;; FIXME: please improve! 1346- :forward-token FUN
1371 (message "%S" smie-indent-debug-log))) 1347- :backward-token FUN"
1372 1348 (set (make-local-variable 'smie-rules-function) rules-function)
1373(defun smie-setup (op-levels indent-rules)
1374 (set (make-local-variable 'smie-indent-rules) indent-rules)
1375 (set (make-local-variable 'smie-op-levels) op-levels) 1349 (set (make-local-variable 'smie-op-levels) op-levels)
1376 (set (make-local-variable 'indent-line-function) 'smie-indent-line)) 1350 (set (make-local-variable 'indent-line-function) 'smie-indent-line)
1351 (set (make-local-variable 'forward-sexp-function)
1352 'smie-forward-sexp-command)
1353 (while keywords
1354 (let ((k (pop keywords))
1355 (v (pop keywords)))
1356 (case k
1357 (:forward-token
1358 (set (make-local-variable 'smie-forward-token-function) v))
1359 (:backward-token
1360 (set (make-local-variable 'smie-backward-token-function) v))
1361 (t (message "smie-setup: ignoring unknown keyword %s" k)))))
1362 (let ((ca (cdr (assq :smie-closer-alist op-levels))))
1363 (when ca
1364 (set (make-local-variable 'smie-closer-alist) ca)
1365 ;; Only needed for interactive calls to blink-matching-open.
1366 (set (make-local-variable 'blink-matching-check-function)
1367 #'smie-blink-matching-check)
1368 (add-hook 'post-self-insert-hook
1369 #'smie-blink-matching-open 'append 'local)
1370 (set (make-local-variable 'smie-blink-matching-triggers)
1371 (append smie-blink-matching-triggers
1372 ;; Rather than wait for SPC to blink, try to blink as
1373 ;; soon as we type the last char of a block ender.
1374 (let ((closers (sort (mapcar #'cdr smie-closer-alist)
1375 #'string-lessp))
1376 (triggers ())
1377 closer)
1378 (while (setq closer (pop closers))
1379 (unless (and closers
1380 ;; FIXME: this eliminates prefixes of other
1381 ;; closers, but we should probably elimnate
1382 ;; prefixes of other keywords as well.
1383 (string-prefix-p closer (car closers)))
1384 (push (aref closer (1- (length closer))) triggers)))
1385 (delete-dups triggers)))))))
1377 1386
1378 1387
1379(provide 'smie) 1388(provide 'smie)
diff --git a/lisp/faces.el b/lisp/faces.el
index 5e421f3f70a..62428c0d29d 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -30,7 +30,7 @@
30(eval-when-compile 30(eval-when-compile
31 (require 'cl)) 31 (require 'cl))
32 32
33(declare-function xw-defined-colors "term/x-win" (&optional frame)) 33(declare-function xw-defined-colors "term/common-win" (&optional frame))
34 34
35(defvar help-xref-stack-item) 35(defvar help-xref-stack-item)
36 36
@@ -1957,7 +1957,7 @@ Value is the new parameter list."
1957 (list (cons 'cursor-color fg))))))) 1957 (list (cons 'cursor-color fg)))))))
1958 1958
1959(declare-function x-create-frame "xfns.c" (parms)) 1959(declare-function x-create-frame "xfns.c" (parms))
1960(declare-function x-setup-function-keys "term/x-win" (frame)) 1960(declare-function x-setup-function-keys "term/common-win" (frame))
1961 1961
1962(defun x-create-frame-with-faces (&optional parameters) 1962(defun x-create-frame-with-faces (&optional parameters)
1963 "Create and return a frame with frame parameters PARAMETERS. 1963 "Create and return a frame with frame parameters PARAMETERS.
@@ -2578,5 +2578,4 @@ also the same size as FACE on FRAME, or fail."
2578 2578
2579(provide 'faces) 2579(provide 'faces)
2580 2580
2581;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6
2582;;; faces.el ends here 2581;;; faces.el ends here
diff --git a/lisp/files.el b/lisp/files.el
index d5f60b7817d..0c5640d13a4 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -188,32 +188,6 @@ If the buffer is visiting a new file, the value is nil.")
188 "Non-nil if visited file was read-only when visited.") 188 "Non-nil if visited file was read-only when visited.")
189(make-variable-buffer-local 'buffer-file-read-only) 189(make-variable-buffer-local 'buffer-file-read-only)
190 190
191(defcustom temporary-file-directory
192 (file-name-as-directory
193 ;; FIXME ? Should there be Ftemporary_file_directory to do the
194 ;; following more robustly (cf set_local_socket in emacsclient.c).
195 ;; It could be used elsewhere, eg Fcall_process_region, server-socket-dir.
196 ;; See bug#7135.
197 (cond ((memq system-type '(ms-dos windows-nt))
198 (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
199 ((eq system-type 'darwin)
200 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP")
201 (let ((tmp (ignore-errors (shell-command-to-string ; bug#7135
202 "getconf DARWIN_USER_TEMP_DIR"))))
203 (and (stringp tmp)
204 (setq tmp (replace-regexp-in-string "\n\\'" "" tmp))
205 ;; This handles "getconf: Unrecognized variable..."
206 (file-directory-p tmp)
207 tmp))
208 "/tmp"))
209 (t
210 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
211 "The directory for writing temporary files."
212 :group 'files
213 ;; Darwin section added 24.1, does not seem worth :version bump.
214 :initialize 'custom-initialize-delay
215 :type 'directory)
216
217(defcustom small-temporary-file-directory 191(defcustom small-temporary-file-directory
218 (if (eq system-type 'ms-dos) (getenv "TMPDIR")) 192 (if (eq system-type 'ms-dos) (getenv "TMPDIR"))
219 "The directory for writing small temporary files. 193 "The directory for writing small temporary files.
@@ -6470,5 +6444,4 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
6470(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) 6444(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
6471(define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame) 6445(define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame)
6472 6446
6473;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f
6474;;; files.el ends here 6447;;; files.el ends here
diff --git a/lisp/finder.el b/lisp/finder.el
index 8471edd57ff..655ad5383b0 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -198,7 +198,8 @@ from; the default is `load-path'."
198 (setq summary (lm-synopsis) 198 (setq summary (lm-synopsis)
199 keywords (mapcar 'intern (lm-keywords-list)) 199 keywords (mapcar 'intern (lm-keywords-list))
200 package (or package-override 200 package (or package-override
201 (intern-soft (lm-header "package")) 201 (let ((str (lm-header "package")))
202 (if str (intern str)))
202 base-name) 203 base-name)
203 version (lm-header "version"))) 204 version (lm-header "version")))
204 (when summary 205 (when summary
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 15664e87aa6..4ebf11251b9 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,264 @@
12010-11-01 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * shr.el: No need to declare `declare-function' since shr.el is for
4 only Emacsen that provide `libxml-parse-html-region'.
5
62010-11-01 Glenn Morris <rgm@gnu.org>
7
8 * mm-util.el (gnus-completing-read): Autoload.
9 (mm-read-coding-system): Simplify Emacs definition.
10
11 * nnmail.el (gnus-activate-group):
12 * nnimap.el (gnutls-negotiate):
13 * nntp.el (netrc-parse): Fix declarations.
14
152010-11-01 Katsumi Yamaoka <yamaoka@jpl.org>
16
17 * gnus-util.el (gnus-string-match-p): New function, that is an alias to
18 string-match-p in Emacs >=23.
19
20 * gnus-msg.el (gnus-configure-posting-styles)
21 * nnir.el (nnir-run-gmane): Use gnus-string-match-p.
22
232010-11-01 Glenn Morris <rgm@gnu.org>
24
25 * nnir.el (declare-function): Add compat stub.
26 (mm-url-insert, mm-url-encode-www-form-urlencoded): Declare.
27 (nnir-run-gmane): Require 'mm-url.
28
29 * mm-util.el (mm-string-to-multibyte): Simplify.
30
31 * shr.el (declare-function): Add compat stub.
32 (url-cache-create-filename): Declare.
33 (mm-disable-multibyte, widget-convert-button): Autoload.
34
35 * smime.el (ldap-search): Declare.
36 (smime-cert-by-ldap-1): Require ldap on Emacs.
37
38 * nnimap.el: Require nnmail, and gnus-sum when compiling.
39 (nnimap-keepalive): Use gnus-float-time.
40
41 * mail-source.el (nnheader-message, gnus-float-time): Autoload.
42 (mail-source-delete-crash-box): Use gnus-float-time.
43
44 * gnus-dired.el (gnus-completing-read): Autoload.
45
46 * mm-view.el (gnus-rescale-image): Autoload.
47
48 * mm-decode.el (gnus-completing-read, gnus-blocked-images): Autoload.
49
50 * gnus.el (gnus-sloppily-equal-method-parameters): Move defn before use.
51
52 * sieve-manage.el: Require 'cl when compiling.
53
54 * gnus-util.el (iswitchb-read-buffer): Declare rather than autoload.
55 (gnus-iswitchb-completing-read): Require iswitchb.
56 (gnus-select-frame-set-input-focus): Silence compiler.
57
582010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
59
60 * message.el (message-subject-trailing-was-query): Change default to t,
61 since I think that's what most people want.
62
63 * nnimap.el (nnimap-request-accept-article): Erase buffer before
64 appending for easier debugging.
65 (nnimap-wait-for-connection): Take a regexp.
66 (nnimap-request-accept-article): Wait for the continuation line before
67 sending anything unless we're streaming.
68
69 * gnus-art.el (gnus-treat-article): Only inhibit body washing, and
70 leave the header washing to take place.
71
722010-10-31 Daniel Dehennin <daniel.dehennin@baby-gnu.org>
73
74 * gnus-msg.el (gnus-configure-posting-styles): Permit the use of
75 regular expression match and replace in posting styles.
76
772010-10-31 Andrew Cohen <cohen@andy.bu.edu>
78
79 * nnir.el (gnus-group-make-nnir-group,nnir-run-query): Allow searching
80 an entire server.
81 (nnir-get-active): New function.
82 (nnir-run-imap): Use it.
83 (nnir-run-gmane): Who knew, gmane search returns an article score!
84
85 * gnus-srvr.el (gnus-server-mode-map): add binding "G" to search the
86 server on the current line with nnir.
87
882010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
89
90 * gnus-cite.el (gnus-article-foldable-buffer): Refactor out.
91 (gnus-article-foldable-buffer): Don't fold regions that have a ragged
92 left edge.
93 (gnus-article-foldable-buffer): Skip past the prefix when determining
94 raggedness.
95
96 * gnus-sum.el (gnus-summary-show-article): Add `C-u C-u g' for showing
97 the raw article, and change `C-u g' to show the article without doing
98 treatments.
99
100 * gnus-art.el (gnus-mime-display-alternative): Actually pass the type
101 on to `gnus-treat-article'.
102 (gnus-inhibit-article-treatments): New variable.
103
104 * gnus.el: Autoload gnus-article-fill-cited-long-lines.
105
106 * gnus-art.el (gnus-treatment-function-alist): Have
107 gnus-treat-fill-long-lines point to gnus-article-fill-cited-long-lines.
108 (gnus-treat-fill-long-lines): Change default to fill all text/plain
109 sections.
110
111 * gnus-cite.el (gnus-article-fill-cited-article): Remove unused `force'
112 parameter.
113 (gnus-article-fill-cited-long-lines): New function.
114 (gnus-article-fill-cited-article): Allow filling only long sections.
115
116 * shr.el (shr-find-fill-point): Don't break lines between punctuation
117 and non-punctuation (like after the apostrophe in "'We").
118
119 * gnus-sum.el (gnus-summary-select-article): Make sure
120 gnus-original-article-buffer is alive.
121
122 * nndoc.el (nndoc-dissect-buffer): Reverse the order of the articles to
123 reflect the order they're in in the digest.
124
125 * gnus.el (gnus-group-startup-message): Move point to the start of the
126 buffer.
127
128 * nnimap.el (nnimap-capability): New function.
129 (nnimap-open-connection): Only send AUTHENTICATE PLAIN if LOGINDISABLED
130 is set.
131
1322010-10-31 David Engster <dengste@eml.cc>
133
134 * nnmairix.el (nnmairix-get-valid-servers): Return list of strings to
135 conform with changes to gnus-completing-read.
136
1372010-10-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
138
139 * shr.el (shr-tag-img): Output "*" instead of "[img]".
140
1412010-10-30 Andrew Cohen <cohen@andy.bu.edu>
142
143 * nnir.el move defvar, defcustom around to keep file organized and keep
144 byte-compiler quiet.
145 (nnir-read-parms): accept search-engine as arg.
146 (nnir-run-query): pass search-engine as arg.
147 (nnir-search-engine): remove.
148
1492010-10-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
150
151 * shr.el (shr-generic): The text nodes should be text, not :text.
152
153 * nnir.el (nnir-search-engine): Ressurect variable, since it's used
154 later in the file.
155
1562010-10-30 Andrew Cohen <cohen@andy.bu.edu>
157
158 * nnir.el: general clean up. allow searching with multiple
159 engines. allow separate extra-parameters for each engine. batch queries
160 when possible.
161 (nnir-imap-default-search-key,nnir-method-default-engines): add
162 customize interface.
163 (nnir-run-gmane): new engine.
164 (nnir-engines): use it. qualify all prompts with engine name.
165 (nnir-search-engine): remove global variable.
166 (nnir-run-hyrex): restore for now.
167 (nnir-extra-parms,nnir-search-history): new variables.
168 (gnus-group-make-nnir-group): use them.
169 (nnir-group-server): remove in favor of gnus-group-server.
170 (nnir-request-group): avoid searching twice.
171 (nnir-sort-groups-by-server): new function.
172
1732010-10-30 Julien Danjou <julien@danjou.info>
174
175 * gnus-group.el: Remove gnus-group-fetch-control.
176
177 * gnus-start.el (gnus-find-new-newsgroups): Remove
178 gnus-check-first-time-used.
179
180 * gnus.el: Remove gnus-backup-default-subscribed-newsgroups.
181
1822010-10-30 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
183
184 * nnimap.el (nnimap-update-info): Allow 'ticked and other flags to be
185 set on groups that don't have \* permanentflags.
186
1872010-10-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
188
189 * shr.el (shr-tag-span): Drop colorisation of regions since we don't
190 control the background color.
191 (shr-tag-img): Ignore very small web bug type images.
192 (shr-put-image): Add help-echo alt texts to the images.
193 (shr-tag-video): Show the video poster image.
194
1952010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
196
197 * shr.el (shr-table-depth): New variable.
198 (shr-tag-table-1): Only insert the images after the top-level table.
199
200 * nnimap.el (nnimap-split-incoming-mail): Fix typo.
201
202 * gnus-util.el (gnus-list-memq-of-list): New function.
203
204 * nnimap.el (nnimap-split-incoming-mail): Note that the INBOX has been
205 selected.
206 (nnimap-unsplittable-articles): New slot.
207 (nnimap-new-articles): Use it.
208
2092010-10-29 Stephen Berman <stephen.berman@gmx.net> (tiny change)
210
211 * gnus-group.el (gnus-group-get-new-news-this-group): Don't have point
212 move to the previous line on `M-g'.
213
2142010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
215
216 * gnus-msg.el (gnus-inews-do-gcc): Don't have the backends do the slow
217 *-request-group, which seems unnecessary.
218
219 * nnimap.el (nnimap-quote-specials): Function copied over from
220 imap.el.
221 (nnimap-open-connection): Use AUTHENTICATE PLAIN on servers that say
222 they support that. Suggested by Tom Regner.
223
2242010-10-29 Julien Danjou <julien@danjou.info>
225
226 * gnus-sum.el (gnus-summary-delete-marked-as-read): Remove obsolete
227 defalias.
228 (gnus-summary-delete-marked-with): Remove obsolete defalias.
229
230 * gnus.el: Remove `gnus-nntp-service' variable.
231 (gnus-secondary-servers): Make obsolete.
232 (gnus-nntp-server): Make obsolete.
233
234 * gnus-start.el (gnus-1): Remove x-splash calls.
235
236 * gnus-ems.el (gnus-x-splash): Remove.
237
238 * gnus.el (gnus-group-startup-message): Simplify/update code.
239
240 * gnus-group.el (gnus-group-make-tool-bar): Check for display graphic
241 capability before doing anything.
242 (gnus-group-insert-group-line): Remove useless
243 gnus-group-remove-excess-properties.
244
2452010-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
246
247 * gnus-art.el (gnus-article-goto-part): Work for article narrowed by ^L.
248
2492010-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
250
251 * gnus-sum.el (gnus-summary-rescan-group): Try to restore the window
252 config after reselecting.
253
2542010-10-28 Julien Danjou <julien@danjou.info>
255
256 * shr.el (shr-put-image): Use point even if only inserting text.
257 (shr-put-image): Save excursion when inserting alt text on non-graphic
258 display, so the behaviour is the same when we are on a graphic display.
259
260 * nnir.el (nnir-run-swish-e): Remove hyrex support.
261
12010-10-28 Katsumi Yamaoka <yamaoka@jpl.org> 2622010-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
2 263
3 * gnus-art.el (gnus-article-jump-to-part): Error on no part; fix prompt. 264 * gnus-art.el (gnus-article-jump-to-part): Error on no part; fix prompt.
@@ -429,12 +690,12 @@
429 690
430 * nnimap.el (gnutls-negotiate): Silence the byte compiler. 691 * nnimap.el (gnutls-negotiate): Silence the byte compiler.
431 692
432 * gnus-art.el, gnus-cache.el, gnus-fun.el, gnus-group.el, 693 * gnus-art.el, gnus-cache.el, gnus-fun.el, gnus-group.el:
433 gnus-picon.el, gnus-spec.el, gnus-sum.el, gnus-util.el, gnus.el, 694 * gnus-picon.el, gnus-spec.el, gnus-sum.el, gnus-util.el, gnus.el:
434 mail-source.el, message.el, mm-bodies.el, mm-decode.el, mm-extern.el, 695 * mail-source.el, message.el, mm-bodies.el, mm-decode.el, mm-extern.el:
435 mm-util.el, mm-view.el, mml-smime.el, mml.el, mml1991.el, mml2015.el, 696 * mm-util.el, mm-view.el, mml-smime.el, mml.el, mml1991.el, mml2015.el:
436 nnfolder.el, nnheader.el, nnmail.el, nnmaildir.el, nnrss.el, nntp.el, 697 * nnfolder.el, nnheader.el, nnmail.el, nnmaildir.el, nnrss.el, nntp.el:
437 rfc1843.el, sieve-manage.el, smime.el, spam.el: 698 * rfc1843.el, sieve-manage.el, smime.el, spam.el:
438 Fix comment for declare-function. 699 Fix comment for declare-function.
439 700
4402010-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org> 7012010-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -1334,7 +1595,7 @@
1334 1595
13352010-09-27 David Engster <dengste@eml.cc> 15962010-09-27 David Engster <dengste@eml.cc>
1336 1597
1337 * nnmairix.el: (nnmairix-replace-group-and-numbers): Deal with NOV as 1598 * nnmairix.el (nnmairix-replace-group-and-numbers): Deal with NOV as
1338 well as HEADERS. 1599 well as HEADERS.
1339 (nnmairix-retrieve-headers): Provide new argument for the above. 1600 (nnmairix-retrieve-headers): Provide new argument for the above.
1340 1601
@@ -1712,7 +1973,7 @@
1712 (nnimap-make-process-buffer): Store all the process buffers. 1973 (nnimap-make-process-buffer): Store all the process buffers.
1713 (nnimap-keepalive): New function. 1974 (nnimap-keepalive): New function.
1714 1975
1715 * starttls.el: (starttls-open-stream): Add autoload cookie. 1976 * starttls.el (starttls-open-stream): Add autoload cookie.
1716 1977
17172010-09-24 Michael Welsh Duggan <md5i@md5i.com> (tiny change) 19782010-09-24 Michael Welsh Duggan <md5i@md5i.com> (tiny change)
1718 1979
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b4b16797ad7..713773ea882 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1590,7 +1590,7 @@ predicate. See Info node `(gnus)Customizing Articles'."
1590 :link '(custom-manual "(gnus)Customizing Articles") 1590 :link '(custom-manual "(gnus)Customizing Articles")
1591 :type gnus-article-treat-custom) 1591 :type gnus-article-treat-custom)
1592 1592
1593(defcustom gnus-treat-fill-long-lines nil 1593(defcustom gnus-treat-fill-long-lines '(typep "text/plain")
1594 "Fill long lines. 1594 "Fill long lines.
1595Valid values are nil, t, `head', `first', `last', an integer or a 1595Valid values are nil, t, `head', `first', `last', an integer or a
1596predicate. See Info node `(gnus)Customizing Articles'." 1596predicate. See Info node `(gnus)Customizing Articles'."
@@ -1664,7 +1664,7 @@ regexp."
1664 (gnus-treat-highlight-signature gnus-article-highlight-signature) 1664 (gnus-treat-highlight-signature gnus-article-highlight-signature)
1665 (gnus-treat-buttonize gnus-article-add-buttons) 1665 (gnus-treat-buttonize gnus-article-add-buttons)
1666 (gnus-treat-fill-article gnus-article-fill-cited-article) 1666 (gnus-treat-fill-article gnus-article-fill-cited-article)
1667 (gnus-treat-fill-long-lines gnus-article-fill-long-lines) 1667 (gnus-treat-fill-long-lines gnus-article-fill-cited-long-lines)
1668 (gnus-treat-strip-cr gnus-article-remove-cr) 1668 (gnus-treat-strip-cr gnus-article-remove-cr)
1669 (gnus-treat-unsplit-urls gnus-article-unsplit-urls) 1669 (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
1670 (gnus-treat-date-ut gnus-article-date-ut) 1670 (gnus-treat-date-ut gnus-article-date-ut)
@@ -5561,35 +5561,41 @@ all parts."
5561 5561
5562(defun gnus-article-goto-part (n) 5562(defun gnus-article-goto-part (n)
5563 "Go to MIME part N." 5563 "Go to MIME part N."
5564 (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) 5564 (when gnus-break-pages
5565 part handle end next handles) 5565 (widen))
5566 (when start 5566 (prog1
5567 (goto-char start) 5567 (let ((start (text-property-any (point-min) (point-max) 'gnus-part n))
5568 (if (setq handle (get-text-property start 'gnus-data)) 5568 part handle end next handles)
5569 start 5569 (when start
5570 ;; Go to the displayed subpart, assuming this is multipart/alternative. 5570 (goto-char start)
5571 (setq part start 5571 (if (setq handle (get-text-property start 'gnus-data))
5572 end (point-at-eol)) 5572 start
5573 (while (and (not handle) 5573 ;; Go to the displayed subpart, assuming this is
5574 part 5574 ;; multipart/alternative.
5575 (< part end) 5575 (setq part start
5576 (setq next (text-property-not-all part end 5576 end (point-at-eol))
5577 'gnus-data nil))) 5577 (while (and (not handle)
5578 (setq part next 5578 part
5579 handle (get-text-property part 'gnus-data)) 5579 (< part end)
5580 (push (cons handle part) handles) 5580 (setq next (text-property-not-all part end
5581 (unless (mm-handle-displayed-p handle) 5581 'gnus-data nil)))
5582 (setq handle nil 5582 (setq part next
5583 part (text-property-any part end 'gnus-data nil)))) 5583 handle (get-text-property part 'gnus-data))
5584 (unless handle 5584 (push (cons handle part) handles)
5585 ;; No subpart is displayed, so we find preferred one. 5585 (unless (mm-handle-displayed-p handle)
5586 (setq part 5586 (setq handle nil
5587 (cdr (assq (mm-preferred-alternative 5587 part (text-property-any part end 'gnus-data nil))))
5588 (nreverse (mapcar 'car handles))) 5588 (unless handle
5589 handles)))) 5589 ;; No subpart is displayed, so we find preferred one.
5590 (if part 5590 (setq part
5591 (goto-char (1+ part)) 5591 (cdr (assq (mm-preferred-alternative
5592 start))))) 5592 (nreverse (mapcar 'car handles)))
5593 handles))))
5594 (if part
5595 (goto-char (1+ part))
5596 start))))
5597 (when gnus-break-pages
5598 (gnus-narrow-to-page))))
5593 5599
5594(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) 5600(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
5595 (let ((gnus-tmp-name 5601 (let ((gnus-tmp-name
@@ -5698,7 +5704,7 @@ all parts."
5698 (save-restriction 5704 (save-restriction
5699 (article-goto-body) 5705 (article-goto-body)
5700 (narrow-to-region (point) (point-max)) 5706 (narrow-to-region (point) (point-max))
5701 (gnus-treat-article nil 1 1) 5707 (gnus-treat-article nil 1 1 "text/plain")
5702 (widen))) 5708 (widen)))
5703 (unless ihandles 5709 (unless ihandles
5704 ;; Highlight the headers. 5710 ;; Highlight the headers.
@@ -5986,7 +5992,7 @@ If displaying \"text/html\" is discouraged \(see
5986 (gnus-treat-article 5992 (gnus-treat-article
5987 nil (length gnus-article-mime-handle-alist) 5993 nil (length gnus-article-mime-handle-alist)
5988 (gnus-article-mime-total-parts) 5994 (gnus-article-mime-total-parts)
5989 (mm-handle-media-type handle)))))) 5995 (mm-handle-media-type preferred))))))
5990 (goto-char (point-max)) 5996 (goto-char (point-max))
5991 (setcdr begend (point-marker))))) 5997 (setcdr begend (point-marker)))))
5992 (when ibegend 5998 (when ibegend
@@ -8249,6 +8255,8 @@ For example:
8249;;; Treatment top-level handling. 8255;;; Treatment top-level handling.
8250;;; 8256;;;
8251 8257
8258(defvar gnus-inhibit-article-treatments nil)
8259
8252(defun gnus-treat-article (condition &optional part-number total-parts type) 8260(defun gnus-treat-article (condition &optional part-number total-parts type)
8253 (let ((length (- (point-max) (point-min))) 8261 (let ((length (- (point-max) (point-min)))
8254 (alist gnus-treatment-function-alist) 8262 (alist gnus-treatment-function-alist)
@@ -8271,6 +8279,8 @@ For example:
8271 (symbol-value (car elem)))) 8279 (symbol-value (car elem))))
8272 (when (and (or (consp val) 8280 (when (and (or (consp val)
8273 treated-type) 8281 treated-type)
8282 (or (not gnus-inhibit-article-treatments)
8283 (eq condition 'head))
8274 (gnus-treat-predicate val) 8284 (gnus-treat-predicate val)
8275 (or (not (get (car elem) 'highlight)) 8285 (or (not (get (car elem) 'highlight))
8276 highlightp)) 8286 highlightp))
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 7419cedac5f..a010a833e9d 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -516,10 +516,15 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
516 (setq m (cdr m)))) 516 (setq m (cdr m))))
517 marks)))) 517 marks))))
518 518
519(defun gnus-article-fill-cited-article (&optional force width) 519(defun gnus-article-fill-cited-long-lines ()
520 (gnus-article-fill-cited-article nil t))
521
522(defun gnus-article-fill-cited-article (&optional width long-lines)
520 "Do word wrapping in the current article. 523 "Do word wrapping in the current article.
521If WIDTH (the numerical prefix), use that text width when filling." 524If WIDTH (the numerical prefix), use that text width when
522 (interactive (list t current-prefix-arg)) 525filling. If LONG-LINES, only fill sections that have lines
526longer than the frame width."
527 (interactive "P")
523 (with-current-buffer gnus-article-buffer 528 (with-current-buffer gnus-article-buffer
524 (let ((buffer-read-only nil) 529 (let ((buffer-read-only nil)
525 (inhibit-point-motion-hooks t) 530 (inhibit-point-motion-hooks t)
@@ -535,8 +540,12 @@ If WIDTH (the numerical prefix), use that text width when filling."
535 (fill-prefix 540 (fill-prefix
536 (if (string= (cdar marks) "") "" 541 (if (string= (cdar marks) "") ""
537 (concat (cdar marks) " "))) 542 (concat (cdar marks) " ")))
543 (do-fill (not long-lines))
538 use-hard-newlines) 544 use-hard-newlines)
539 (fill-region (point-min) (point-max))) 545 (unless do-fill
546 (setq do-fill (gnus-article-foldable-buffer (cdar marks))))
547 (when do-fill
548 (fill-region (point-min) (point-max))))
540 (set-marker (caar marks) nil) 549 (set-marker (caar marks) nil)
541 (setq marks (cdr marks))) 550 (setq marks (cdr marks)))
542 (when marks 551 (when marks
@@ -548,6 +557,28 @@ If WIDTH (the numerical prefix), use that text width when filling."
548 gnus-cite-loose-attribution-alist nil 557 gnus-cite-loose-attribution-alist nil
549 gnus-cite-article nil))))) 558 gnus-cite-article nil)))))
550 559
560(defun gnus-article-foldable-buffer (prefix)
561 (let ((do-fill nil)
562 columns)
563 (goto-char (point-min))
564 (while (not (eobp))
565 (forward-char (length prefix))
566 (skip-chars-forward " \t")
567 (unless (eolp)
568 (let ((elem (assq (current-column) columns)))
569 (unless elem
570 (setq elem (cons (current-column) 0))
571 (push elem columns))
572 (setcdr elem (1+ (cdr elem)))))
573 (end-of-line)
574 (when (> (current-column) (frame-width))
575 (setq do-fill t))
576 (forward-line 1))
577 (and do-fill
578 ;; We know know that there are long lines here, but does this look
579 ;; like code? Check for ragged edges on the left.
580 (< (length columns) 3))))
581
551(defun gnus-article-natural-long-line-p () 582(defun gnus-article-natural-long-line-p ()
552 "Return true if the current line is long, and it's natural text." 583 "Return true if the current line is long, and it's natural text."
553 (save-excursion 584 (save-excursion
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index a12046f73b8..8b6d3911e11 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -1,7 +1,7 @@
1;;; gnus-dired.el --- utility functions where gnus and dired meet 1;;; gnus-dired.el --- utility functions where gnus and dired meet
2 2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 2005,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Authors: Benjamin Rutt <brutt@bloomington.in.us>, 6;; Authors: Benjamin Rutt <brutt@bloomington.in.us>,
7;; Shenghuo Zhu <zsh@cs.rochester.edu> 7;; Shenghuo Zhu <zsh@cs.rochester.edu>
@@ -122,6 +122,8 @@ See `mail-user-agent' for more information."
122 (push (buffer-name buffer) buffers)))) 122 (push (buffer-name buffer) buffers))))
123 (nreverse buffers)))) 123 (nreverse buffers))))
124 124
125(autoload 'gnus-completing-read "gnus-util")
126
125;; Method to attach files to a mail composition. 127;; Method to attach files to a mail composition.
126(defun gnus-dired-attach (files-to-attach) 128(defun gnus-dired-attach (files-to-attach)
127 "Attach dired's marked files to a gnus message composition. 129 "Attach dired's marked files to a gnus message composition.
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index e1e37eb37c2..3a79e67801f 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -162,102 +162,6 @@
162(autoload 'gnus-alive-p "gnus-util") 162(autoload 'gnus-alive-p "gnus-util")
163(autoload 'mm-disable-multibyte "mm-util") 163(autoload 'mm-disable-multibyte "mm-util")
164 164
165(defun gnus-x-splash ()
166 "Show a splash screen using a pixmap in the current buffer."
167 (interactive)
168 (unless window-system
169 (error "`gnus-x-splash' requires running on the window system"))
170 (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p)
171 (interactive-p))
172 "*gnus-x-splash*"
173 gnus-group-buffer)))
174 (let ((inhibit-read-only t)
175 (file (nnheader-find-etc-directory "images/gnus/x-splash" t))
176 pixmap fcw fch width height fringes sbars left yoffset top ls)
177 (erase-buffer)
178 (sit-for 0) ;; Necessary for measuring the window size correctly.
179 (when (and file
180 (ignore-errors
181 (let ((coding-system-for-read 'raw-text))
182 (with-temp-buffer
183 (mm-disable-multibyte)
184 (insert-file-contents file)
185 (goto-char (point-min))
186 (setq pixmap (read (current-buffer)))))))
187 (setq fcw (float (frame-char-width))
188 fch (float (frame-char-height))
189 width (/ (car pixmap) fcw)
190 height (/ (cadr pixmap) fch)
191 fringes (if (fboundp 'window-fringes)
192 (eval '(window-fringes))
193 '(10 11 nil))
194 sbars (frame-parameter nil 'vertical-scroll-bars))
195 (cond ((eq sbars 'right)
196 (setq sbars
197 (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14)
198 fcw))))
199 (sbars
200 (setq sbars
201 (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14)
202 fcw)
203 0)))
204 (t
205 (setq sbars '(0 . 0))))
206 (setq left (- (* (round (/ (1- (/ (+ (window-width)
207 (car sbars) (cdr sbars)
208 (/ (+ (or (car fringes) 0)
209 (or (cadr fringes) 0))
210 fcw))
211 width))
212 2))
213 width)
214 (car sbars)
215 (/ (or (car fringes) 0) fcw))
216 yoffset (cadr (window-edges))
217 top (max 0 (- (* (max (if (and (boundp 'tool-bar-mode)
218 tool-bar-mode
219 (not (featurep 'gtk))
220 (eq (frame-first-window)
221 (selected-window)))
222 1 0)
223 (round (/ (1- (/ (+ (1- (window-height))
224 (* 2 yoffset))
225 height))
226 2)))
227 height)
228 yoffset))
229 ls (/ (or line-spacing 0) fch)
230 height (max 0 (- height ls)))
231 (cond ((>= (- top ls) 1)
232 (insert
233 (propertize
234 " "
235 'display `(space :width 0 :ascent 100))
236 "\n"
237 (propertize
238 " "
239 'display `(space :width 0 :height ,(- top ls 1) :ascent 100))
240 "\n"))
241 ((> (- top ls) 0)
242 (insert
243 (propertize
244 " "
245 'display `(space :width 0 :height ,(- top ls) :ascent 100))
246 "\n")))
247 (if (and (> width 0) (> left 0))
248 (insert (propertize
249 " "
250 'display `(space :width ,left :height ,height :ascent 0)))
251 (setq width (+ width left)))
252 (when (> width 0)
253 (insert (propertize
254 " "
255 'display `(space :width ,width :height ,height :ascent 0)
256 'face `(gnus-splash :stipple ,pixmap))))
257 (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min)))
258 (redraw-frame (selected-frame))
259 (sit-for 0))))
260
261;;; Image functions. 165;;; Image functions.
262 166
263(defun gnus-image-type-available-p (type) 167(defun gnus-image-type-available-p (type)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 3f3cd24963f..24215a61950 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -741,7 +741,6 @@ simple manner.")
741 "e" gnus-score-edit-all-score) 741 "e" gnus-score-edit-all-score)
742 742
743(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) 743(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
744 "C" gnus-group-fetch-control
745 "d" gnus-group-describe-group 744 "d" gnus-group-describe-group
746 "v" gnus-version) 745 "v" gnus-version)
747 746
@@ -807,10 +806,6 @@ simple manner.")
807 ["Describe" gnus-group-describe-group :active (gnus-group-group-name) 806 ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
808 ,@(if (featurep 'xemacs) nil 807 ,@(if (featurep 'xemacs) nil
809 '(:help "Display description of the current group"))] 808 '(:help "Display description of the current group"))]
810 ["Fetch control message" gnus-group-fetch-control
811 :active (gnus-group-group-name)
812 ,@(if (featurep 'xemacs) nil
813 '(:help "Display the archived control message for the current group"))]
814 ;; Actually one should check, if any of the marked groups gives t for 809 ;; Actually one should check, if any of the marked groups gives t for
815 ;; (gnus-check-backend-function 'request-expire-articles ...) 810 ;; (gnus-check-backend-function 'request-expire-articles ...)
816 ["Expire articles" gnus-group-expire-articles 811 ["Expire articles" gnus-group-expire-articles
@@ -1090,8 +1085,7 @@ When FORCE, rebuild the tool bar."
1090 (when (and (not (featurep 'xemacs)) 1085 (when (and (not (featurep 'xemacs))
1091 (boundp 'tool-bar-mode) 1086 (boundp 'tool-bar-mode)
1092 tool-bar-mode 1087 tool-bar-mode
1093 ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode). 1088 (display-graphic-p)
1094 ;; Why? --rsteib
1095 (or (not gnus-group-tool-bar-map) force)) 1089 (or (not gnus-group-tool-bar-map) force))
1096 (let* ((load-path 1090 (let* ((load-path
1097 (gmm-image-load-path-for-library "gnus" 1091 (gmm-image-load-path-for-library "gnus"
@@ -1607,9 +1601,7 @@ if it is a string, only list groups matching REGEXP."
1607 (when (inline (gnus-visual-p 'group-highlight 'highlight)) 1601 (when (inline (gnus-visual-p 'group-highlight 'highlight))
1608 (gnus-group-highlight-line gnus-tmp-group beg end)) 1602 (gnus-group-highlight-line gnus-tmp-group beg end))
1609 (gnus-run-hooks 'gnus-group-update-hook) 1603 (gnus-run-hooks 'gnus-group-update-hook)
1610 (forward-line) 1604 (forward-line)))
1611 ;; Allow XEmacs to remove front-sticky text properties.
1612 (gnus-group-remove-excess-properties)))
1613 1605
1614(defun gnus-group-update-eval-form (group list) 1606(defun gnus-group-update-eval-form (group list)
1615 "Eval `car' of each element of LIST, and return the first that return t. 1607 "Eval `car' of each element of LIST, and return the first that return t.
@@ -3991,7 +3983,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
3991 (let* ((groups (gnus-group-process-prefix n)) 3983 (let* ((groups (gnus-group-process-prefix n))
3992 (ret (if (numberp n) (- n (length groups)) 0)) 3984 (ret (if (numberp n) (- n (length groups)) 0))
3993 (beg (unless n 3985 (beg (unless n
3994 (point))) 3986 (point-marker)))
3995 group method 3987 group method
3996 (gnus-inhibit-demon t) 3988 (gnus-inhibit-demon t)
3997 ;; Binding this variable will inhibit multiple fetchings 3989 ;; Binding this variable will inhibit multiple fetchings
@@ -4025,32 +4017,6 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
4025 (gnus-group-position-point) 4017 (gnus-group-position-point)
4026 ret)) 4018 ret))
4027 4019
4028(defun gnus-group-fetch-control (group)
4029 "Fetch the archived control messages for the current group.
4030If given a prefix argument, prompt for a group."
4031 (interactive
4032 (list (or (when current-prefix-arg
4033 (gnus-group-completing-read))
4034 (gnus-group-group-name)
4035 gnus-newsgroup-name)))
4036 (unless group
4037 (error "No group name given"))
4038 (let ((name (gnus-group-real-name group))
4039 hierarchy)
4040 (when (string-match "\\(^[^\\.]+\\)\\..*" name)
4041 (setq hierarchy (match-string 1 name))
4042 (if gnus-group-fetch-control-use-browse-url
4043 (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
4044 hierarchy "/" name ".gz"))
4045 (let ((enable-local-variables nil))
4046 (gnus-group-read-ephemeral-group
4047 group
4048 `(nndoc ,group (nndoc-address
4049 ,(find-file-noselect
4050 (concat "/ftp@ftp.isc.org:/usenet/control/"
4051 hierarchy "/" name ".gz")))
4052 (nndoc-article-type mbox)) t nil nil))))))
4053
4054(defun gnus-group-describe-group (force &optional group) 4020(defun gnus-group-describe-group (force &optional group)
4055 "Display a description of the current newsgroup." 4021 "Display a description of the current newsgroup."
4056 (interactive (list current-prefix-arg (gnus-group-group-name))) 4022 (interactive (list current-prefix-arg (gnus-group-group-name)))
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 318cdfebda2..b344a5ef15c 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -100,8 +100,6 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
100 ;; Stream is already opened. 100 ;; Stream is already opened.
101 nil 101 nil
102 ;; Open NNTP server. 102 ;; Open NNTP server.
103 (unless gnus-nntp-service
104 (setq gnus-nntp-server nil))
105 (when confirm 103 (when confirm
106 ;; Read server name with completion. 104 ;; Read server name with completion.
107 (setq gnus-nntp-server 105 (setq gnus-nntp-server
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index a3c5112ee41..544aa7776a8 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1628,7 +1628,7 @@ this is a reply."
1628 (unless (gnus-check-server method) 1628 (unless (gnus-check-server method)
1629 (error "Can't open server %s" (if (stringp method) method 1629 (error "Can't open server %s" (if (stringp method) method
1630 (car method)))) 1630 (car method))))
1631 (unless (gnus-request-group group nil method) 1631 (unless (gnus-request-group group t method)
1632 (gnus-request-create-group group method)) 1632 (gnus-request-create-group group method))
1633 (setq mml-externalize-attachments 1633 (setq mml-externalize-attachments
1634 (if (stringp gnus-gcc-externalize-attachments) 1634 (if (stringp gnus-gcc-externalize-attachments)
@@ -1891,7 +1891,11 @@ this is a reply."
1891 (setq v 1891 (setq v
1892 (cond 1892 (cond
1893 ((stringp value) 1893 ((stringp value)
1894 value) 1894 (if (and (stringp match)
1895 (gnus-string-match-p "\\\\[&[:digit:]]" value)
1896 (match-beginning 1))
1897 (gnus-match-substitute-replacement value nil nil group)
1898 value))
1895 ((or (symbolp value) 1899 ((or (symbolp value)
1896 (functionp value)) 1900 (functionp value))
1897 (cond ((functionp value) 1901 (cond ((functionp value)
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index b532b740455..ae773657d24 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -34,6 +34,8 @@
34(require 'gnus-int) 34(require 'gnus-int)
35(require 'gnus-range) 35(require 'gnus-range)
36 36
37(autoload 'gnus-group-make-nnir-group "nnir")
38
37(defcustom gnus-server-mode-hook nil 39(defcustom gnus-server-mode-hook nil
38 "Hook run in `gnus-server-mode' buffers." 40 "Hook run in `gnus-server-mode' buffers."
39 :group 'gnus-server 41 :group 'gnus-server
@@ -165,6 +167,8 @@ If nil, a faster, but more primitive, buffer is used instead."
165 167
166 "g" gnus-server-regenerate-server 168 "g" gnus-server-regenerate-server
167 169
170 "G" gnus-group-make-nnir-group
171
168 "z" gnus-server-compact-server 172 "z" gnus-server-compact-server
169 173
170 "\C-c\C-i" gnus-info-find-node 174 "\C-c\C-i" gnus-info-find-node
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index dafcd642727..f480d304d4b 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -775,14 +775,6 @@ prompt the user for the name of an NNTP server to use."
775 (if gnus-agent 775 (if gnus-agent
776 (gnus-agentize)) 776 (gnus-agentize))
777 777
778 (when gnus-simple-splash
779 (setq gnus-simple-splash nil)
780 (cond
781 ((featurep 'xemacs)
782 (gnus-xmas-splash))
783 (window-system
784 (gnus-x-splash))))
785
786 (let ((level (and (numberp arg) (> arg 0) arg)) 778 (let ((level (and (numberp arg) (> arg 0) arg))
787 did-connect) 779 did-connect)
788 (unwind-protect 780 (unwind-protect
@@ -1108,53 +1100,52 @@ for new groups, and subscribe the new groups as zombies."
1108 'gnus-subscribe-zombies) 1100 'gnus-subscribe-zombies)
1109 t) 1101 t)
1110 (t gnus-check-new-newsgroups)))) 1102 (t gnus-check-new-newsgroups))))
1111 (unless (gnus-check-first-time-used) 1103 (if (or (consp check)
1112 (if (or (consp check) 1104 (eq check 'ask-server))
1113 (eq check 'ask-server)) 1105 ;; Ask the server for new groups.
1114 ;; Ask the server for new groups. 1106 (gnus-ask-server-for-new-groups)
1115 (gnus-ask-server-for-new-groups) 1107 ;; Go through the active hashtb and look for new groups.
1116 ;; Go through the active hashtb and look for new groups. 1108 (let ((groups 0)
1117 (let ((groups 0) 1109 group new-newsgroups)
1118 group new-newsgroups) 1110 (gnus-message 5 "Looking for new newsgroups...")
1119 (gnus-message 5 "Looking for new newsgroups...") 1111 (unless gnus-have-read-active-file
1120 (unless gnus-have-read-active-file 1112 (gnus-read-active-file))
1121 (gnus-read-active-file)) 1113 (setq gnus-newsrc-last-checked-date (message-make-date))
1122 (setq gnus-newsrc-last-checked-date (message-make-date)) 1114 (unless gnus-killed-hashtb
1123 (unless gnus-killed-hashtb 1115 (gnus-make-hashtable-from-killed))
1124 (gnus-make-hashtable-from-killed)) 1116 ;; Go though every newsgroup in `gnus-active-hashtb' and compare
1125 ;; Go though every newsgroup in `gnus-active-hashtb' and compare 1117 ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
1126 ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. 1118 (mapatoms
1127 (mapatoms 1119 (lambda (sym)
1128 (lambda (sym) 1120 (if (or (null (setq group (symbol-name sym)))
1129 (if (or (null (setq group (symbol-name sym))) 1121 (not (boundp sym))
1130 (not (boundp sym)) 1122 (null (symbol-value sym))
1131 (null (symbol-value sym)) 1123 (gnus-gethash group gnus-killed-hashtb)
1132 (gnus-gethash group gnus-killed-hashtb) 1124 (gnus-gethash group gnus-newsrc-hashtb))
1133 (gnus-gethash group gnus-newsrc-hashtb)) 1125 ()
1134 () 1126 (let ((do-sub (gnus-matches-options-n group)))
1135 (let ((do-sub (gnus-matches-options-n group))) 1127 (cond
1136 (cond 1128 ((eq do-sub 'subscribe)
1137 ((eq do-sub 'subscribe) 1129 (setq groups (1+ groups))
1138 (setq groups (1+ groups)) 1130 (gnus-sethash group group gnus-killed-hashtb)
1139 (gnus-sethash group group gnus-killed-hashtb) 1131 (gnus-call-subscribe-functions
1140 (gnus-call-subscribe-functions 1132 gnus-subscribe-options-newsgroup-method group))
1141 gnus-subscribe-options-newsgroup-method group)) 1133 ((eq do-sub 'ignore)
1142 ((eq do-sub 'ignore) 1134 nil)
1143 nil) 1135 (t
1144 (t 1136 (setq groups (1+ groups))
1145 (setq groups (1+ groups)) 1137 (gnus-sethash group group gnus-killed-hashtb)
1146 (gnus-sethash group group gnus-killed-hashtb) 1138 (if gnus-subscribe-hierarchical-interactive
1147 (if gnus-subscribe-hierarchical-interactive 1139 (push group new-newsgroups)
1148 (push group new-newsgroups) 1140 (gnus-call-subscribe-functions
1149 (gnus-call-subscribe-functions 1141 gnus-subscribe-newsgroup-method group)))))))
1150 gnus-subscribe-newsgroup-method group))))))) 1142 gnus-active-hashtb)
1151 gnus-active-hashtb) 1143 (when new-newsgroups
1152 (when new-newsgroups 1144 (gnus-subscribe-hierarchical-interactive new-newsgroups))
1153 (gnus-subscribe-hierarchical-interactive new-newsgroups)) 1145 (if (> groups 0)
1154 (if (> groups 0) 1146 (gnus-message 5 "%d new newsgroup%s arrived."
1155 (gnus-message 5 "%d new newsgroup%s arrived." 1147 groups (if (> groups 1) "s have" " has"))
1156 groups (if (> groups 1) "s have" " has")) 1148 (gnus-message 5 "No new newsgroups."))))))
1157 (gnus-message 5 "No new newsgroups.")))))))
1158 1149
1159(defun gnus-matches-options-n (group) 1150(defun gnus-matches-options-n (group)
1160 ;; Returns `subscribe' if the group is to be unconditionally 1151 ;; Returns `subscribe' if the group is to be unconditionally
@@ -1254,53 +1245,6 @@ for new groups, and subscribe the new groups as zombies."
1254 (setq gnus-newsrc-last-checked-date new-date)) 1245 (setq gnus-newsrc-last-checked-date new-date))
1255 got-new)) 1246 got-new))
1256 1247
1257(defun gnus-check-first-time-used ()
1258 (catch 'ended
1259 ;; First check if any of the following files exist. If they do,
1260 ;; it's not the first time the user has used Gnus.
1261 (dolist (file (list (concat gnus-current-startup-file ".el")
1262 (concat gnus-current-startup-file ".eld")
1263 (concat gnus-startup-file ".el")
1264 (concat gnus-startup-file ".eld")))
1265 (when (file-exists-p file)
1266 (throw 'ended nil)))
1267 (gnus-message 6 "First time user; subscribing you to default groups")
1268 (unless (gnus-read-active-file-p)
1269 (let ((gnus-read-active-file t))
1270 (gnus-read-active-file)))
1271 (setq gnus-newsrc-last-checked-date (message-make-date))
1272 ;; Subscribe to the default newsgroups.
1273 (let ((groups (or gnus-default-subscribed-newsgroups
1274 gnus-backup-default-subscribed-newsgroups))
1275 group)
1276 (if (eq groups t)
1277 ;; If t, we subscribe (or not) all groups as if they were new.
1278 (mapatoms
1279 (lambda (sym)
1280 (when (setq group (symbol-name sym))
1281 (let ((do-sub (gnus-matches-options-n group)))
1282 (cond
1283 ((eq do-sub 'subscribe)
1284 (gnus-sethash group group gnus-killed-hashtb)
1285 (gnus-call-subscribe-functions
1286 gnus-subscribe-options-newsgroup-method group))
1287 ((eq do-sub 'ignore)
1288 nil)
1289 (t
1290 (push group gnus-killed-list))))))
1291 gnus-active-hashtb)
1292 (dolist (group groups)
1293 ;; Only subscribe the default groups that are activated.
1294 (when (gnus-active group)
1295 (gnus-group-change-level
1296 group gnus-level-default-subscribed gnus-level-killed)))
1297 (with-current-buffer gnus-group-buffer
1298 ;; Don't error if the group already exists. This happens when a
1299 ;; first-time user types 'F'. -- didier
1300 (gnus-group-make-help-group t))
1301 (when gnus-novice-user
1302 (gnus-message 7 "`A k' to list killed groups"))))))
1303
1304(defun gnus-subscribe-group (group &optional previous method) 1248(defun gnus-subscribe-group (group &optional previous method)
1305 "Subscribe GROUP and put it after PREVIOUS." 1249 "Subscribe GROUP and put it after PREVIOUS."
1306 (gnus-group-change-level 1250 (gnus-group-change-level
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index ca540b0f22f..7de7a0a4a26 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -2169,8 +2169,7 @@ increase the score of each group you read."
2169 "v" gnus-version 2169 "v" gnus-version
2170 "d" gnus-summary-describe-group 2170 "d" gnus-summary-describe-group
2171 "h" gnus-summary-describe-briefly 2171 "h" gnus-summary-describe-briefly
2172 "i" gnus-info-find-node 2172 "i" gnus-info-find-node)
2173 "C" gnus-group-fetch-control)
2174 2173
2175(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) 2174(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
2176 "e" gnus-summary-expire-articles 2175 "e" gnus-summary-expire-articles
@@ -2747,9 +2746,6 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2747 ["Original sort" gnus-summary-sort-by-original t]) 2746 ["Original sort" gnus-summary-sort-by-original t])
2748 ("Help" 2747 ("Help"
2749 ["Describe group" gnus-summary-describe-group t] 2748 ["Describe group" gnus-summary-describe-group t]
2750 ["Fetch control message" gnus-group-fetch-control
2751 ,@(if (featurep 'xemacs) nil
2752 '(:help "Display the archived control message for the current group"))]
2753 ["Read manual" gnus-info-find-node t]) 2749 ["Read manual" gnus-info-find-node t])
2754 ("Modes" 2750 ("Modes"
2755 ["Pick and read" gnus-pick-mode t] 2751 ["Pick and read" gnus-pick-mode t]
@@ -7033,7 +7029,11 @@ The prefix argument ALL means to select all articles."
7033(defun gnus-summary-rescan-group (&optional all) 7029(defun gnus-summary-rescan-group (&optional all)
7034 "Exit the newsgroup, ask for new articles, and select the newsgroup." 7030 "Exit the newsgroup, ask for new articles, and select the newsgroup."
7035 (interactive "P") 7031 (interactive "P")
7036 (gnus-summary-reselect-current-group all t)) 7032 (let ((config gnus-current-window-configuration))
7033 (gnus-summary-reselect-current-group all t)
7034 (gnus-configure-windows config)
7035 (when (eq config 'article)
7036 (gnus-summary-select-article))))
7037 7037
7038(defun gnus-summary-update-info (&optional non-destructive) 7038(defun gnus-summary-update-info (&optional non-destructive)
7039 (save-excursion 7039 (save-excursion
@@ -7596,6 +7596,7 @@ be displayed."
7596 (not (get-buffer gnus-original-article-buffer)))) 7596 (not (get-buffer gnus-original-article-buffer))))
7597 (and (not gnus-single-article-buffer) 7597 (and (not gnus-single-article-buffer)
7598 (or (null gnus-current-article) 7598 (or (null gnus-current-article)
7599 (not (get-buffer gnus-original-article-buffer))
7599 (not (eq gnus-current-article article)))) 7600 (not (eq gnus-current-article article))))
7600 force) 7601 force)
7601 ;; The requested article is different from the current article. 7602 ;; The requested article is different from the current article.
@@ -8299,10 +8300,6 @@ articles that are younger than AGE days."
8299 (gnus-summary-limit articles)) 8300 (gnus-summary-limit articles))
8300 (gnus-summary-position-point)) 8301 (gnus-summary-position-point))
8301 8302
8302(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
8303(make-obsolete
8304 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4")
8305
8306(defun gnus-summary-limit-to-unread (&optional all) 8303(defun gnus-summary-limit-to-unread (&optional all)
8307 "Limit the summary buffer to articles that are not marked as read. 8304 "Limit the summary buffer to articles that are not marked as read.
8308If ALL is non-nil, limit strictly to unread articles." 8305If ALL is non-nil, limit strictly to unread articles."
@@ -8393,10 +8390,6 @@ If UNREPLIED (the prefix), limit to unreplied articles."
8393 (gnus-summary-limit gnus-newsgroup-replied)) 8390 (gnus-summary-limit gnus-newsgroup-replied))
8394 (gnus-summary-position-point)) 8391 (gnus-summary-position-point))
8395 8392
8396(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
8397(make-obsolete 'gnus-summary-delete-marked-with
8398 'gnus-summary-limit-exclude-marks "Emacs 20.4")
8399
8400(defun gnus-summary-limit-exclude-marks (marks &optional reverse) 8393(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
8401 "Exclude articles that are marked with MARKS (e.g. \"DK\"). 8394 "Exclude articles that are marked with MARKS (e.g. \"DK\").
8402If REVERSE, limit the summary buffer to articles that are marked 8395If REVERSE, limit the summary buffer to articles that are marked
@@ -9400,9 +9393,10 @@ article currently."
9400If ARG (the prefix) is a number, show the article with the charset 9393If ARG (the prefix) is a number, show the article with the charset
9401defined in `gnus-summary-show-article-charset-alist', or the charset 9394defined in `gnus-summary-show-article-charset-alist', or the charset
9402input. 9395input.
9403If ARG (the prefix) is non-nil and not a number, show the raw article 9396If ARG (the prefix) is non-nil and not a number, show the article,
9404without any article massaging functions being run. Normally, the key 9397but without running any of the article treatment functions
9405strokes are `C-u g'." 9398article. Normally, the keystroke is `C-u g'. When using `C-u
9399C-u g', show the raw article."
9406 (interactive "P") 9400 (interactive "P")
9407 (cond 9401 (cond
9408 ((numberp arg) 9402 ((numberp arg)
@@ -9444,7 +9438,8 @@ strokes are `C-u g'."
9444 ((not arg) 9438 ((not arg)
9445 ;; Select the article the normal way. 9439 ;; Select the article the normal way.
9446 (gnus-summary-select-article nil 'force)) 9440 (gnus-summary-select-article nil 'force))
9447 (t 9441 ((equal arg '(16))
9442 ;; C-u C-u g
9448 ;; We have to require this here to make sure that the following 9443 ;; We have to require this here to make sure that the following
9449 ;; dynamic binding isn't shadowed by autoloading. 9444 ;; dynamic binding isn't shadowed by autoloading.
9450 (require 'gnus-async) 9445 (require 'gnus-async)
@@ -9462,6 +9457,9 @@ strokes are `C-u g'."
9462 ;; Set it to nil for safety reason. 9457 ;; Set it to nil for safety reason.
9463 (setq gnus-article-mime-handle-alist nil) 9458 (setq gnus-article-mime-handle-alist nil)
9464 (setq gnus-article-mime-handles nil))) 9459 (setq gnus-article-mime-handles nil)))
9460 (gnus-summary-select-article nil 'force)))
9461 (t
9462 (let ((gnus-inhibit-article-treatments t))
9465 (gnus-summary-select-article nil 'force)))) 9463 (gnus-summary-select-article nil 'force))))
9466 (gnus-summary-goto-subject gnus-current-article) 9464 (gnus-summary-goto-subject gnus-current-article)
9467 (gnus-summary-position-point)) 9465 (gnus-summary-position-point))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 1a09e04193b..94b7c633196 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1651,10 +1651,14 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1651 initial-input history def)) 1651 initial-input history def))
1652 1652
1653 1653
1654(autoload 'iswitchb-read-buffer "iswitchb") 1654(declare-function iswitchb-read-buffer "iswitchb"
1655 (prompt &optional default require-match start matches-set))
1656(defvar iswitchb-temp-buflist)
1657
1655(defun gnus-iswitchb-completing-read (prompt collection &optional require-match 1658(defun gnus-iswitchb-completing-read (prompt collection &optional require-match
1656 initial-input history def) 1659 initial-input history def)
1657 "`iswitchb' based completing-read function." 1660 "`iswitchb' based completing-read function."
1661 (require 'iswitchb)
1658 (let ((iswitchb-make-buflist-hook 1662 (let ((iswitchb-make-buflist-hook
1659 (lambda () 1663 (lambda ()
1660 (setq iswitchb-temp-buflist 1664 (setq iswitchb-temp-buflist
@@ -1667,11 +1671,11 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1667 (nreverse filtered-choices)))))) 1671 (nreverse filtered-choices))))))
1668 (unwind-protect 1672 (unwind-protect
1669 (progn 1673 (progn
1670 (when (not iswitchb-mode) 1674 (or iswitchb-mode
1671 (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) 1675 (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
1672 (iswitchb-read-buffer prompt def require-match)) 1676 (iswitchb-read-buffer prompt def require-match))
1673 (when (not iswitchb-mode) 1677 (or iswitchb-mode
1674 (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) 1678 (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))
1675 1679
1676(defun gnus-graphic-display-p () 1680(defun gnus-graphic-display-p ()
1677 (if (featurep 'xemacs) 1681 (if (featurep 'xemacs)
@@ -1758,14 +1762,16 @@ CHOICE is a list of the choice char and help message at IDX."
1758 (kill-buffer buf)) 1762 (kill-buffer buf))
1759 tchar)) 1763 tchar))
1760 1764
1761(if (fboundp 'select-frame-set-input-focus) 1765(if (featurep 'emacs)
1762 (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus) 1766 (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus)
1763 ;; XEmacs 21.4, SXEmacs 1767 (if (fboundp 'select-frame-set-input-focus)
1764 (defun gnus-select-frame-set-input-focus (frame) 1768 (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus)
1765 "Select FRAME, raise it, and set input focus, if possible." 1769 ;; XEmacs 21.4, SXEmacs
1766 (raise-frame frame) 1770 (defun gnus-select-frame-set-input-focus (frame)
1767 (select-frame frame) 1771 "Select FRAME, raise it, and set input focus, if possible."
1768 (focus-frame frame))) 1772 (raise-frame frame)
1773 (select-frame frame)
1774 (focus-frame frame))))
1769 1775
1770(defun gnus-frame-or-window-display-name (object) 1776(defun gnus-frame-or-window-display-name (object)
1771 "Given a frame or window, return the associated display name. 1777 "Given a frame or window, return the associated display name.
@@ -1974,6 +1980,44 @@ Sizes are in pixels."
1974 image))) 1980 image)))
1975 image))) 1981 image)))
1976 1982
1983(defun gnus-list-memq-of-list (elements list)
1984 "Return non-nil if any of the members of ELEMENTS are in LIST."
1985 (let ((found nil))
1986 (dolist (elem elements)
1987 (setq found (or found
1988 (memq elem list))))
1989 found))
1990
1991(eval-and-compile
1992 (cond
1993 ((fboundp 'match-substitute-replacement)
1994 (defalias 'gnus-match-substitute-replacement 'match-substitute-replacement))
1995 (t
1996 (defun gnus-match-substitute-replacement (replacement &optional fixedcase literal string subexp)
1997 "Return REPLACEMENT as it will be inserted by `replace-match'.
1998In other words, all back-references in the form `\\&' and `\\N'
1999are substituted with actual strings matched by the last search.
2000Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same
2001meaning as for `replace-match'.
2002
2003This is the definition of match-substitute-replacement in subr.el from GNU Emacs."
2004 (let ((match (match-string 0 string)))
2005 (save-match-data
2006 (set-match-data (mapcar (lambda (x)
2007 (if (numberp x)
2008 (- x (match-beginning 0))
2009 x))
2010 (match-data t)))
2011 (replace-match replacement fixedcase literal match subexp)))))))
2012
2013(if (fboundp 'string-match-p)
2014 (defalias 'gnus-string-match-p 'string-match-p)
2015 (defsubst gnus-string-match-p (regexp string &optional start)
2016 "\
2017Same as `string-match' except this function does not change the match data."
2018 (save-match-data
2019 (string-match regexp string start))))
2020
1977(provide 'gnus-util) 2021(provide 'gnus-util)
1978 2022
1979;;; gnus-util.el ends here 2023;;; gnus-util.el ends here
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index bd78c6aef35..82cfd672be7 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1,8 +1,8 @@
1;;; gnus.el --- a newsreader for GNU Emacs 1;;; gnus.el --- a newsreader for GNU Emacs
2 2
3;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, 3;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997,
4;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 4;; 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
5;; Free Software Foundation, Inc. 5;; 2010 Free Software Foundation, Inc.
6 6
7;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 7;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8;; Lars Magne Ingebrigtsen <larsi@gnus.org> 8;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -308,9 +308,6 @@ be set in `.emacs' instead."
308 :group 'gnus-start 308 :group 'gnus-start
309 :type 'boolean) 309 :type 'boolean)
310 310
311(unless (fboundp 'gnus-group-remove-excess-properties)
312 (defalias 'gnus-group-remove-excess-properties 'ignore))
313
314(unless (featurep 'gnus-xmas) 311(unless (featurep 'gnus-xmas)
315 (defalias 'gnus-make-overlay 'make-overlay) 312 (defalias 'gnus-make-overlay 'make-overlay)
316 (defalias 'gnus-delete-overlay 'delete-overlay) 313 (defalias 'gnus-delete-overlay 'delete-overlay)
@@ -353,7 +350,6 @@ be set in `.emacs' instead."
353 (list str)) 350 (list str))
354 line))) 351 line)))
355 (defalias 'gnus-mode-line-buffer-identification 'identity)) 352 (defalias 'gnus-mode-line-buffer-identification 'identity))
356 (defalias 'gnus-characterp 'numberp)
357 (defalias 'gnus-deactivate-mark 'deactivate-mark) 353 (defalias 'gnus-deactivate-mark 'deactivate-mark)
358 (defalias 'gnus-window-edges 'window-edges) 354 (defalias 'gnus-window-edges 'window-edges)
359 (defalias 'gnus-key-press-event-p 'numberp) 355 (defalias 'gnus-key-press-event-p 'numberp)
@@ -921,7 +917,8 @@ be set in `.emacs' instead."
921;;; Gnus buffers 917;;; Gnus buffers
922;;; 918;;;
923 919
924(defvar gnus-buffers nil) 920(defvar gnus-buffers nil
921 "List of buffers handled by Gnus.")
925 922
926(defun gnus-get-buffer-create (name) 923(defun gnus-get-buffer-create (name)
927 "Do the same as `get-buffer-create', but store the created buffer." 924 "Do the same as `get-buffer-create', but store the created buffer."
@@ -953,7 +950,8 @@ be set in `.emacs' instead."
953 950
954;;; Splash screen. 951;;; Splash screen.
955 952
956(defvar gnus-group-buffer "*Group*") 953(defvar gnus-group-buffer "*Group*"
954 "Name of the Gnus group buffer.")
957 955
958(defface gnus-splash 956(defface gnus-splash
959 '((((class color) 957 '((((class color)
@@ -992,8 +990,6 @@ be set in `.emacs' instead."
992 (while (search-forward "\t" nil t) 990 (while (search-forward "\t" nil t)
993 (replace-match " " t t)))))) 991 (replace-match " " t t))))))
994 992
995(defvar gnus-simple-splash nil)
996
997;;(format "%02x%02x%02x" 114 66 20) "724214" 993;;(format "%02x%02x%02x" 114 66 20) "724214"
998 994
999(defvar gnus-logo-color-alist 995(defvar gnus-logo-color-alist
@@ -1033,50 +1029,47 @@ be set in `.emacs' instead."
1033 "Insert startup message in current buffer." 1029 "Insert startup message in current buffer."
1034 ;; Insert the message. 1030 ;; Insert the message.
1035 (erase-buffer) 1031 (erase-buffer)
1036 (cond 1032 (unless (and
1037 ((and 1033 (fboundp 'find-image)
1038 (fboundp 'find-image) 1034 (display-graphic-p)
1039 (display-graphic-p) 1035 ;; Make sure the library defining `image-load-path' is
1040 ;; Make sure the library defining `image-load-path' is loaded 1036 ;; loaded (`find-image' is autoloaded) (and discard the
1041 ;; (`find-image' is autoloaded) (and discard the result). Else, we may 1037 ;; result). Else, we may get "defvar ignored because
1042 ;; get "defvar ignored because image-load-path is let-bound" when calling 1038 ;; image-load-path is let-bound" when calling `find-image'
1043 ;; `find-image' below. 1039 ;; below.
1044 (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) 1040 (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t)
1045 (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) 1041 (let* ((data-directory (nnheader-find-etc-directory "images/gnus"))
1046 (image-load-path (cond (data-directory 1042 (image-load-path (cond (data-directory
1047 (list data-directory)) 1043 (list data-directory))
1048 ((boundp 'image-load-path) 1044 ((boundp 'image-load-path)
1049 (symbol-value 'image-load-path)) 1045 (symbol-value 'image-load-path))
1050 (t load-path))) 1046 (t load-path)))
1051 (image (find-image 1047 (image (find-image
1052 `((:type xpm :file "gnus.xpm" 1048 `((:type xpm :file "gnus.xpm"
1053 :color-symbols 1049 :color-symbols
1054 (("thing" . ,(car gnus-logo-colors)) 1050 (("thing" . ,(car gnus-logo-colors))
1055 ("shadow" . ,(cadr gnus-logo-colors)) 1051 ("shadow" . ,(cadr gnus-logo-colors))))
1056 ("oort" . "#eeeeee") 1052 (:type svg :file "gnus.svg")
1057 ("background" . ,(face-background 'default)))) 1053 (:type png :file "gnus.png")
1058 (:type svg :file "gnus.svg") 1054 (:type pbm :file "gnus.pbm"
1059 (:type png :file "gnus.png") 1055 ;; Account for the pbm's background.
1060 (:type pbm :file "gnus.pbm" 1056 :background ,(face-foreground 'gnus-splash)
1061 ;; Account for the pbm's blackground. 1057 :foreground ,(face-background 'default))
1062 :background ,(face-foreground 'gnus-splash) 1058 (:type xbm :file "gnus.xbm"
1063 :foreground ,(face-background 'default)) 1059 ;; Account for the xbm's background.
1064 (:type xbm :file "gnus.xbm" 1060 :background ,(face-foreground 'gnus-splash)
1065 ;; Account for the xbm's blackground. 1061 :foreground ,(face-background 'default))))))
1066 :background ,(face-foreground 'gnus-splash) 1062 (when image
1067 :foreground ,(face-background 'default)))))) 1063 (let ((size (image-size image)))
1068 (when image 1064 (insert-char ?\n (max 0 (round (- (window-height)
1069 (let ((size (image-size image))) 1065 (or y (cdr size)) 1) 2)))
1070 (insert-char ?\n (max 0 (round (- (window-height) 1066 (insert-char ?\ (max 0 (round (- (window-width)
1071 (or y (cdr size)) 1) 2))) 1067 (or x (car size))) 2)))
1072 (insert-char ?\ (max 0 (round (- (window-width) 1068 (insert-image image))
1073 (or x (car size))) 2))) 1069 (goto-char (point-min))
1074 (insert-image image)) 1070 t)))
1075 (setq gnus-simple-splash nil)
1076 t))))
1077 (t
1078 (insert 1071 (insert
1079 (format " %s 1072 (format "
1080 _ ___ _ _ 1073 _ ___ _ _
1081 _ ___ __ ___ __ _ ___ 1074 _ ___ __ ___ __ _ ___
1082 __ _ ___ __ ___ 1075 __ _ ___ __ ___
@@ -1095,8 +1088,7 @@ be set in `.emacs' instead."
1095 _ 1088 _
1096 __ 1089 __
1097 1090
1098" 1091"))
1099 ""))
1100 ;; And then hack it. 1092 ;; And then hack it.
1101 (gnus-indent-rigidly (point-min) (point-max) 1093 (gnus-indent-rigidly (point-min) (point-max)
1102 (/ (max (- (window-width) (or x 46)) 0) 2)) 1094 (/ (max (- (window-width) (or x 46)) 0) 2))
@@ -1108,10 +1100,9 @@ be set in `.emacs' instead."
1108 (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) 1100 (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
1109 ;; Fontify some. 1101 ;; Fontify some.
1110 (put-text-property (point-min) (point-max) 'face 'gnus-splash) 1102 (put-text-property (point-min) (point-max) 'face 'gnus-splash)
1111 (setq gnus-simple-splash t))) 1103 (goto-char (point-min))
1112 (goto-char (point-min)) 1104 (setq mode-line-buffer-identification (concat " " gnus-version))
1113 (setq mode-line-buffer-identification (concat " " gnus-version)) 1105 (set-buffer-modified-p t)))
1114 (set-buffer-modified-p t))
1115 1106
1116(eval-when (load) 1107(eval-when (load)
1117 (let ((command (format "%s" this-command))) 1108 (let ((command (format "%s" this-command)))
@@ -1267,15 +1258,6 @@ by the user.
1267If you want to change servers, you should use `gnus-select-method'. 1258If you want to change servers, you should use `gnus-select-method'.
1268See the documentation to that variable.") 1259See the documentation to that variable.")
1269 1260
1270;; Don't touch this variable.
1271(defvar gnus-nntp-service "nntp"
1272 "NNTP service name (\"nntp\" or 119).
1273This is an obsolete variable, which is scarcely used. If you use an
1274nntp server for your newsgroup and want to change the port number
1275used to 899, you would say something along these lines:
1276
1277 (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
1278
1279(defcustom gnus-nntpserver-file "/etc/nntpserver" 1261(defcustom gnus-nntpserver-file "/etc/nntpserver"
1280 "A file with only the name of the nntp server in it." 1262 "A file with only the name of the nntp server in it."
1281 :group 'gnus-files 1263 :group 'gnus-files
@@ -1299,20 +1281,11 @@ Check the NNTPSERVER environment variable and the
1299;;;###autoload (custom-autoload 'gnus-select-method "gnus")) 1281;;;###autoload (custom-autoload 'gnus-select-method "gnus"))
1300 1282
1301(defcustom gnus-select-method 1283(defcustom gnus-select-method
1302 (condition-case nil 1284 (list 'nntp (or (gnus-getenv-nntpserver)
1303 (nconc 1285 (when (and gnus-default-nntp-server
1304 (list 'nntp (or (condition-case nil 1286 (not (string= gnus-default-nntp-server "")))
1305 (gnus-getenv-nntpserver) 1287 gnus-default-nntp-server)
1306 (error nil)) 1288 "news"))
1307 (when (and gnus-default-nntp-server
1308 (not (string= gnus-default-nntp-server "")))
1309 gnus-default-nntp-server)
1310 "news"))
1311 (if (or (null gnus-nntp-service)
1312 (equal gnus-nntp-service "nntp"))
1313 nil
1314 (list gnus-nntp-service)))
1315 (error nil))
1316 "Default method for selecting a newsgroup. 1289 "Default method for selecting a newsgroup.
1317This variable should be a list, where the first element is how the 1290This variable should be a list, where the first element is how the
1318news is to be fetched, the second is the address. 1291news is to be fetched, the second is the address.
@@ -1397,14 +1370,14 @@ To make Gnus query you for a server, you have to give `gnus' a
1397non-numeric prefix - `C-u M-x gnus', in short." 1370non-numeric prefix - `C-u M-x gnus', in short."
1398 :group 'gnus-server 1371 :group 'gnus-server
1399 :type '(repeat string)) 1372 :type '(repeat string))
1373(make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1")
1400 1374
1401(defcustom gnus-nntp-server nil 1375(defcustom gnus-nntp-server nil
1402 "*The name of the host running the NNTP server. 1376 "The name of the host running the NNTP server."
1403This variable is semi-obsolete. Use the `gnus-select-method'
1404variable instead."
1405 :group 'gnus-server 1377 :group 'gnus-server
1406 :type '(choice (const :tag "disable" nil) 1378 :type '(choice (const :tag "disable" nil)
1407 string)) 1379 string))
1380(make-obsolete-variable 'gnus-nntp-server 'gnus-select-method "24.1")
1408 1381
1409(defcustom gnus-secondary-select-methods nil 1382(defcustom gnus-secondary-select-methods nil
1410 "A list of secondary methods that will be used for reading news. 1383 "A list of secondary methods that will be used for reading news.
@@ -1418,11 +1391,6 @@ you could set this variable:
1418 :group 'gnus-server 1391 :group 'gnus-server
1419 :type '(repeat gnus-select-method)) 1392 :type '(repeat gnus-select-method))
1420 1393
1421(defvar gnus-backup-default-subscribed-newsgroups
1422 '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
1423 "Default default new newsgroups the first time Gnus is run.
1424Should be set in paths.el, and shouldn't be touched by the user.")
1425
1426(defcustom gnus-local-domain nil 1394(defcustom gnus-local-domain nil
1427 "Local domain name without a host name. 1395 "Local domain name without a host name.
1428The DOMAINNAME environment variable is used instead if it is defined. 1396The DOMAINNAME environment variable is used instead if it is defined.
@@ -1466,14 +1434,6 @@ list, Gnus will try all the methods in the list until it finds a match."
1466 (nnweb "refer" (nnweb-type google))) 1434 (nnweb "refer" (nnweb-type google)))
1467 gnus-select-method)))) 1435 gnus-select-method))))
1468 1436
1469(defcustom gnus-group-fetch-control-use-browse-url nil
1470 "*Non-nil means that control messages are displayed using `browse-url'.
1471Otherwise they are fetched with ange-ftp and displayed in an ephemeral
1472group."
1473 :version "22.1"
1474 :group 'gnus-group-various
1475 :type 'boolean)
1476
1477(defcustom gnus-use-cross-reference t 1437(defcustom gnus-use-cross-reference t
1478 "*Non-nil means that cross referenced articles will be marked as read. 1438 "*Non-nil means that cross referenced articles will be marked as read.
1479If nil, ignore cross references. If t, mark articles as read in 1439If nil, ignore cross references. If t, mark articles as read in
@@ -1503,7 +1463,7 @@ Also see `gnus-large-ephemeral-newsgroup'."
1503 integer)) 1463 integer))
1504 1464
1505(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v))) 1465(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v)))
1506 "*Non-nil means that the default name of a file to save articles in is the group name. 1466 "Non-nil means that the default name of a file to save articles in is the group name.
1507If it's nil, the directory form of the group name is used instead. 1467If it's nil, the directory form of the group name is used instead.
1508 1468
1509If this variable is a list, and the list contains the element 1469If this variable is a list, and the list contains the element
@@ -1513,8 +1473,8 @@ saving; and if it contains the element `not-kill', long file names
1513will not be used for kill files. 1473will not be used for kill files.
1514 1474
1515Note that the default for this variable varies according to what system 1475Note that the default for this variable varies according to what system
1516type you're using. On `usg-unix-v' and `xenix' this variable defaults 1476type you're using. On `usg-unix-v' this variable defaults to nil while
1517to nil while on all other systems it defaults to t." 1477on all other systems it defaults to t."
1518 :group 'gnus-start 1478 :group 'gnus-start
1519 :type '(radio (sexp :format "Non-nil\n" 1479 :type '(radio (sexp :format "Non-nil\n"
1520 :match (lambda (widget value) 1480 :match (lambda (widget value)
@@ -2814,7 +2774,8 @@ gnus-registry.el will populate this if it's loaded.")
2814 ("gnus-cite" :interactive t 2774 ("gnus-cite" :interactive t
2815 gnus-article-highlight-citation gnus-article-hide-citation-maybe 2775 gnus-article-highlight-citation gnus-article-hide-citation-maybe
2816 gnus-article-hide-citation gnus-article-fill-cited-article 2776 gnus-article-hide-citation gnus-article-fill-cited-article
2817 gnus-article-hide-citation-in-followups) 2777 gnus-article-hide-citation-in-followups
2778 gnus-article-fill-cited-long-lines)
2818 ("gnus-kill" gnus-kill gnus-apply-kill-file-internal 2779 ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
2819 gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author 2780 gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
2820 gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score) 2781 gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
@@ -3585,16 +3546,6 @@ that that variable is buffer-local to the summary buffers."
3585 gnus-valid-select-methods))) 3546 gnus-valid-select-methods)))
3586 (equal (nth 1 m1) (nth 1 m2))))))) 3547 (equal (nth 1 m1) (nth 1 m2)))))))
3587 3548
3588(defun gnus-methods-sloppily-equal (m1 m2)
3589 ;; Same method.
3590 (or
3591 (eq m1 m2)
3592 ;; Type and name are equal.
3593 (and
3594 (eq (car m1) (car m2))
3595 (equal (cadr m1) (cadr m2))
3596 (gnus-sloppily-equal-method-parameters m1 m2))))
3597
3598(defsubst gnus-sloppily-equal-method-parameters (m1 m2) 3549(defsubst gnus-sloppily-equal-method-parameters (m1 m2)
3599 ;; Check parameters for sloppy equalness. 3550 ;; Check parameters for sloppy equalness.
3600 (let ((p1 (copy-sequence (cddr m1))) 3551 (let ((p1 (copy-sequence (cddr m1)))
@@ -3623,6 +3574,16 @@ that that variable is buffer-local to the summary buffers."
3623 ;; If p2 now is empty, they were equal. 3574 ;; If p2 now is empty, they were equal.
3624 (null p2)))) 3575 (null p2))))
3625 3576
3577(defun gnus-methods-sloppily-equal (m1 m2)
3578 ;; Same method.
3579 (or
3580 (eq m1 m2)
3581 ;; Type and name are equal.
3582 (and
3583 (eq (car m1) (car m2))
3584 (equal (cadr m1) (cadr m2))
3585 (gnus-sloppily-equal-method-parameters m1 m2))))
3586
3626(defun gnus-server-equal (m1 m2) 3587(defun gnus-server-equal (m1 m2)
3627 "Say whether two methods are equal." 3588 "Say whether two methods are equal."
3628 (let ((m1 (cond ((null m1) gnus-select-method) 3589 (let ((m1 (cond ((null m1) gnus-select-method)
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 1bd5be74013..137a18f27eb 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -501,6 +501,8 @@ See `mail-source-bind'."
501 (t 501 (t
502 value))) 502 value)))
503 503
504(autoload 'nnheader-message "nnheader")
505
504(defun mail-source-fetch (source callback &optional method) 506(defun mail-source-fetch (source callback &optional method)
505 "Fetch mail from SOURCE and call CALLBACK zero or more times. 507 "Fetch mail from SOURCE and call CALLBACK zero or more times.
506CALLBACK will be called with the name of the file where (some of) 508CALLBACK will be called with the name of the file where (some of)
@@ -594,6 +596,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
594 0) 596 0)
595 (funcall callback mail-source-crash-box info))) 597 (funcall callback mail-source-crash-box info)))
596 598
599(autoload 'gnus-float-time "gnus-util")
600
597(defvar mail-source-incoming-last-checked-time nil) 601(defvar mail-source-incoming-last-checked-time nil)
598 602
599(defun mail-source-delete-crash-box () 603(defun mail-source-delete-crash-box ()
@@ -614,7 +618,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
614 ;; Don't check for old incoming files more than once per day to 618 ;; Don't check for old incoming files more than once per day to
615 ;; save a lot of file accesses. 619 ;; save a lot of file accesses.
616 (when (or (null mail-source-incoming-last-checked-time) 620 (when (or (null mail-source-incoming-last-checked-time)
617 (> (time-to-seconds 621 (> (gnus-float-time
618 (time-since mail-source-incoming-last-checked-time)) 622 (time-since mail-source-incoming-last-checked-time))
619 (* 24 60 60))) 623 (* 24 60 60)))
620 (setq mail-source-incoming-last-checked-time (current-time)) 624 (setq mail-source-incoming-last-checked-time (current-time))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index bac6ef4fac0..48daea844bf 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -306,7 +306,7 @@ any confusion."
306 306
307;;; Start of variables adopted from `message-utils.el'. 307;;; Start of variables adopted from `message-utils.el'.
308 308
309(defcustom message-subject-trailing-was-query 'ask 309(defcustom message-subject-trailing-was-query t
310 "*What to do with trailing \"(was: <old subject>)\" in subject lines. 310 "*What to do with trailing \"(was: <old subject>)\" in subject lines.
311If nil, leave the subject unchanged. If it is the symbol `ask', query 311If nil, leave the subject unchanged. If it is the symbol `ask', query
312the user what do do. In this case, the subject is matched against 312the user what do do. In this case, the subject is matched against
@@ -314,7 +314,7 @@ the user what do do. In this case, the subject is matched against
314`message-subject-trailing-was-query' is t, always strip the trailing 314`message-subject-trailing-was-query' is t, always strip the trailing
315old subject. In this case, `message-subject-trailing-was-regexp' is 315old subject. In this case, `message-subject-trailing-was-regexp' is
316used." 316used."
317 :version "22.1" 317 :version "24.1"
318 :type '(choice (const :tag "never" nil) 318 :type '(choice (const :tag "never" nil)
319 (const :tag "always strip" t) 319 (const :tag "always strip" t)
320 (const ask)) 320 (const ask))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 531206c538e..f3c04cee4f8 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1,7 +1,7 @@
1;;; mm-decode.el --- Functions for decoding MIME things 1;;; mm-decode.el --- Functions for decoding MIME things
2 2
3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7;; MORIOKA Tomohiko <morioka@jaist.ac.jp> 7;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -1324,6 +1324,8 @@ Use CMD as the process."
1324 (let ((coding-system-for-write 'binary)) 1324 (let ((coding-system-for-write 'binary))
1325 (shell-command-on-region (point-min) (point-max) command nil))))) 1325 (shell-command-on-region (point-min) (point-max) command nil)))))
1326 1326
1327(autoload 'gnus-completing-read "gnus-util")
1328
1327(defun mm-interactively-view-part (handle) 1329(defun mm-interactively-view-part (handle)
1328 "Display HANDLE using METHOD." 1330 "Display HANDLE using METHOD."
1329 (let* ((type (mm-handle-media-type handle)) 1331 (let* ((type (mm-handle-media-type handle))
@@ -1683,6 +1685,7 @@ If RECURSIVE, search recursively."
1683 (start end &optional base-url)) 1685 (start end &optional base-url))
1684(declare-function shr-insert-document "shr" (dom)) 1686(declare-function shr-insert-document "shr" (dom))
1685(defvar shr-blocked-images) 1687(defvar shr-blocked-images)
1688(autoload 'gnus-blocked-images "gnus-art")
1686 1689
1687(defun mm-shr (handle) 1690(defun mm-shr (handle)
1688 ;; Require since we bind its variables. 1691 ;; Require since we bind its variables.
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index b16e1d9556b..67b41e0cb3a 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -39,6 +39,10 @@
39 (require 'timer))) 39 (require 'timer)))
40 40
41(defvar mm-mime-mule-charset-alist ) 41(defvar mm-mime-mule-charset-alist )
42;; Note this is not presently used on Emacs >= 23, which is good,
43;; since it means standalone message-mode (which requires mml and
44;; hence mml-util) does not load gnus-util.
45(autoload 'gnus-completing-read "gnus-util")
42 46
43;; Emulate functions that are not available in every (X)Emacs version. 47;; Emulate functions that are not available in every (X)Emacs version.
44;; The name of a function is prefixed with mm-, like `mm-char-int' for 48;; The name of a function is prefixed with mm-, like `mm-char-int' for
@@ -202,19 +206,10 @@ to the contents of the accessible portion of the buffer."
202 (defalias 'mm-decode-coding-region 'decode-coding-region) 206 (defalias 'mm-decode-coding-region 'decode-coding-region)
203 (defalias 'mm-encode-coding-region 'encode-coding-region))) 207 (defalias 'mm-encode-coding-region 'encode-coding-region)))
204 208
205;; `string-to-multibyte' is available only in Emacs 22.1 or greater. 209;; `string-to-multibyte' is available only in Emacs.
206(defalias 'mm-string-to-multibyte 210(defalias 'mm-string-to-multibyte (if (featurep 'xemacs)
207 (cond 211 'identity
208 ((featurep 'xemacs) 212 'string-to-multibyte))
209 'identity)
210 ((fboundp 'string-to-multibyte)
211 'string-to-multibyte)
212 (t
213 (lambda (string)
214 "Return a multibyte string with the same individual chars as STRING."
215 (mapconcat
216 (lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
217 string "")))))
218 213
219;; `char-or-char-int-p' is an XEmacs function, not available in Emacs. 214;; `char-or-char-int-p' is an XEmacs function, not available in Emacs.
220(eval-and-compile 215(eval-and-compile
@@ -272,18 +267,19 @@ to the contents of the accessible portion of the buffer."
272;; Actually, there should be an `mm-coding-system-mime-charset'. 267;; Actually, there should be an `mm-coding-system-mime-charset'.
273(eval-and-compile 268(eval-and-compile
274 (defalias 'mm-read-coding-system 269 (defalias 'mm-read-coding-system
275 (cond 270 (if (featurep 'emacs) 'read-coding-system
276 ((fboundp 'read-coding-system) 271 (cond
277 (if (and (featurep 'xemacs) 272 ((fboundp 'read-coding-system)
278 (<= (string-to-number emacs-version) 21.1)) 273 (if (and (featurep 'xemacs)
279 (lambda (prompt &optional default-coding-system) 274 (<= (string-to-number emacs-version) 21.1))
280 (read-coding-system prompt)) 275 (lambda (prompt &optional default-coding-system)
281 'read-coding-system)) 276 (read-coding-system prompt))
282 (t (lambda (prompt &optional default-coding-system) 277 'read-coding-system))
283 "Prompt the user for a coding system." 278 (t (lambda (prompt &optional default-coding-system)
284 (gnus-completing-read 279 "Prompt the user for a coding system."
285 prompt (mapcar (lambda (s) (symbol-name (car s))) 280 (gnus-completing-read
286 mm-mime-mule-charset-alist))))))) 281 prompt (mapcar (lambda (s) (symbol-name (car s)))
282 mm-mime-mule-charset-alist))))))))
287 283
288(defvar mm-coding-system-list nil) 284(defvar mm-coding-system-list nil)
289(defun mm-get-coding-system-list () 285(defun mm-get-coding-system-list ()
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index abe761ba9f9..f6214759813 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -82,6 +82,8 @@
82;;; Functions for displaying various formats inline 82;;; Functions for displaying various formats inline
83;;; 83;;;
84 84
85(autoload 'gnus-rescale-image "gnus-util")
86
85(defun mm-inline-image-emacs (handle) 87(defun mm-inline-image-emacs (handle)
86 (let ((b (point-marker)) 88 (let ((b (point-marker))
87 (inhibit-read-only t)) 89 (inhibit-read-only t))
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 9f147e32b41..0dee06d2937 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -918,7 +918,8 @@ from the document.")
918 (setq body-end (point)) 918 (setq body-end (point))
919 (push (list (incf i) head-begin head-end body-begin body-end 919 (push (list (incf i) head-begin head-end body-begin body-end
920 (count-lines body-begin body-end)) 920 (count-lines body-begin body-end))
921 nndoc-dissection-alist))))))) 921 nndoc-dissection-alist)))))
922 (setq nndoc-dissection-alist (nreverse nndoc-dissection-alist))))
922 923
923(defun nndoc-article-begin () 924(defun nndoc-article-begin ()
924 (if nndoc-article-begin-function 925 (if nndoc-article-begin-function
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 8ea50632a55..ea8a0fc95e5 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -44,6 +44,10 @@
44(require 'utf7) 44(require 'utf7)
45(require 'tls) 45(require 'tls)
46(require 'parse-time) 46(require 'parse-time)
47(require 'nnmail)
48
49(eval-when-compile
50 (require 'gnus-sum))
47 51
48(autoload 'auth-source-forget-user-or-password "auth-source") 52(autoload 'auth-source-forget-user-or-password "auth-source")
49(autoload 'auth-source-user-or-password "auth-source") 53(autoload 'auth-source-user-or-password "auth-source")
@@ -78,6 +82,9 @@ Uses the same syntax as nnmail-split-methods")
78(defvoo nnimap-split-fancy nil 82(defvoo nnimap-split-fancy nil
79 "Uses the same syntax as nnmail-split-fancy.") 83 "Uses the same syntax as nnmail-split-fancy.")
80 84
85(defvoo nnimap-unsplittable-articles '(%Deleted %Seen)
86 "Articles with the flags in the list will not be considered when splitting.")
87
81(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'" 88(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
82 "Emacs 24.1") 89 "Emacs 24.1")
83 90
@@ -284,7 +291,7 @@ textual parts.")
284 (with-current-buffer buffer 291 (with-current-buffer buffer
285 (when (and nnimap-object 292 (when (and nnimap-object
286 (nnimap-last-command-time nnimap-object) 293 (nnimap-last-command-time nnimap-object)
287 (> (time-to-seconds 294 (> (gnus-float-time
288 (time-subtract 295 (time-subtract
289 now 296 now
290 (nnimap-last-command-time nnimap-object))) 297 (nnimap-last-command-time nnimap-object)))
@@ -292,7 +299,8 @@ textual parts.")
292 (* 5 60))) 299 (* 5 60)))
293 (nnimap-send-command "NOOP"))))))) 300 (nnimap-send-command "NOOP")))))))
294 301
295(declare-function gnutls-negotiate "subr" (fn file &optional arglist fileonly)) 302(declare-function gnutls-negotiate "gnutls"
303 (proc type &optional priority-string trustfiles keyfiles))
296 304
297(defun nnimap-open-connection (buffer) 305(defun nnimap-open-connection (buffer)
298 (unless nnimap-keepalive-timer 306 (unless nnimap-keepalive-timer
@@ -379,14 +387,13 @@ textual parts.")
379 ;; connection and start a STARTTLS connection instead. 387 ;; connection and start a STARTTLS connection instead.
380 (cond 388 (cond
381 ((and (or (and (eq nnimap-stream 'network) 389 ((and (or (and (eq nnimap-stream 'network)
382 (member "STARTTLS" 390 (nnimap-capability "STARTTLS"))
383 (nnimap-capabilities nnimap-object)))
384 (eq nnimap-stream 'starttls)) 391 (eq nnimap-stream 'starttls))
385 (fboundp 'open-gnutls-stream)) 392 (fboundp 'open-gnutls-stream))
386 (nnimap-command "STARTTLS") 393 (nnimap-command "STARTTLS")
387 (gnutls-negotiate (nnimap-process nnimap-object) nil)) 394 (gnutls-negotiate (nnimap-process nnimap-object) nil))
388 ((and (eq nnimap-stream 'network) 395 ((and (eq nnimap-stream 'network)
389 (member "STARTTLS" (nnimap-capabilities nnimap-object))) 396 (nnimap-capability "STARTTLS"))
390 (let ((nnimap-stream 'starttls)) 397 (let ((nnimap-stream 'starttls))
391 (let ((tls-process 398 (let ((tls-process
392 (nnimap-open-connection buffer))) 399 (nnimap-open-connection buffer)))
@@ -412,9 +419,18 @@ textual parts.")
412 ;; physical address. 419 ;; physical address.
413 (nnimap-credentials nnimap-address ports))))) 420 (nnimap-credentials nnimap-address ports)))))
414 (setq nnimap-object nil) 421 (setq nnimap-object nil)
415 (setq login-result (nnimap-command "LOGIN %S %S" 422 (setq login-result
416 (car credentials) 423 (if (and (nnimap-capability "AUTH=PLAIN")
417 (cadr credentials))) 424 (nnimap-capability "LOGINDISABLED"))
425 (nnimap-command
426 "AUTHENTICATE PLAIN %s"
427 (base64-encode-string
428 (format "\000%s\000%s"
429 (nnimap-quote-specials (car credentials))
430 (nnimap-quote-specials (cadr credentials)))))
431 (nnimap-command "LOGIN %S %S"
432 (car credentials)
433 (cadr credentials))))
418 (unless (car login-result) 434 (unless (car login-result)
419 ;; If the login failed, then forget the credentials 435 ;; If the login failed, then forget the credentials
420 ;; that are now possibly cached. 436 ;; that are now possibly cached.
@@ -427,10 +443,20 @@ textual parts.")
427 (delete-process (nnimap-process nnimap-object)) 443 (delete-process (nnimap-process nnimap-object))
428 (setq nnimap-object nil)))) 444 (setq nnimap-object nil))))
429 (when nnimap-object 445 (when nnimap-object
430 (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) 446 (when (nnimap-capability "QRESYNC")
431 (nnimap-command "ENABLE QRESYNC")) 447 (nnimap-command "ENABLE QRESYNC"))
432 (nnimap-process nnimap-object)))))))) 448 (nnimap-process nnimap-object))))))))
433 449
450(defun nnimap-quote-specials (string)
451 (with-temp-buffer
452 (insert string)
453 (goto-char (point-min))
454 (while (re-search-forward "[\\\"]" nil t)
455 (forward-char -1)
456 (insert "\\")
457 (forward-char 1))
458 (buffer-string)))
459
434(defun nnimap-find-parameter (parameter elems) 460(defun nnimap-find-parameter (parameter elems)
435 (let (result) 461 (let (result)
436 (dolist (elem elems) 462 (dolist (elem elems)
@@ -533,8 +559,11 @@ textual parts.")
533 (delete-region (point) (point-max))) 559 (delete-region (point) (point-max)))
534 t))) 560 t)))
535 561
562(defun nnimap-capability (capability)
563 (member capability (nnimap-capabilities nnimap-object)))
564
536(defun nnimap-ver4-p () 565(defun nnimap-ver4-p ()
537 (member "IMAP4REV1" (nnimap-capabilities nnimap-object))) 566 (nnimap-capability "IMAP4REV1"))
538 567
539(defun nnimap-get-partial-article (article parts structure) 568(defun nnimap-get-partial-article (article parts structure)
540 (let ((result 569 (let ((result
@@ -850,7 +879,7 @@ textual parts.")
850 (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)" 879 (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)"
851 (nnimap-article-ranges articles)) 880 (nnimap-article-ranges articles))
852 (cond 881 (cond
853 ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) 882 ((nnimap-capability "UIDPLUS")
854 (nnimap-command "UID EXPUNGE %s" 883 (nnimap-command "UID EXPUNGE %s"
855 (nnimap-article-ranges articles)) 884 (nnimap-article-ranges articles))
856 t) 885 t)
@@ -906,9 +935,12 @@ textual parts.")
906 (nnimap-add-cr) 935 (nnimap-add-cr)
907 (setq message (buffer-substring-no-properties (point-min) (point-max))) 936 (setq message (buffer-substring-no-properties (point-min) (point-max)))
908 (with-current-buffer (nnimap-buffer) 937 (with-current-buffer (nnimap-buffer)
938 (erase-buffer)
909 (setq sequence (nnimap-send-command 939 (setq sequence (nnimap-send-command
910 "APPEND %S {%d}" (utf7-encode group t) 940 "APPEND %S {%d}" (utf7-encode group t)
911 (length message))) 941 (length message)))
942 (unless nnimap-streaming
943 (nnimap-wait-for-connection "^[+]"))
912 (process-send-string (get-buffer-process (current-buffer)) message) 944 (process-send-string (get-buffer-process (current-buffer)) message)
913 (process-send-string (get-buffer-process (current-buffer)) 945 (process-send-string (get-buffer-process (current-buffer))
914 (if (nnimap-newlinep nnimap-object) 946 (if (nnimap-newlinep nnimap-object)
@@ -1009,7 +1041,7 @@ textual parts.")
1009 (with-current-buffer (nnimap-buffer) 1041 (with-current-buffer (nnimap-buffer)
1010 (erase-buffer) 1042 (erase-buffer)
1011 (setf (nnimap-group nnimap-object) nil) 1043 (setf (nnimap-group nnimap-object) nil)
1012 (let ((qresyncp (member "QRESYNC" (nnimap-capabilities nnimap-object))) 1044 (let ((qresyncp (nnimap-capability "QRESYNC"))
1013 params groups sequences active uidvalidity modseq group) 1045 params groups sequences active uidvalidity modseq group)
1014 ;; Go through the infos and gather the data needed to know 1046 ;; Go through the infos and gather the data needed to know
1015 ;; what and how to request the data. 1047 ;; what and how to request the data.
@@ -1181,7 +1213,8 @@ textual parts.")
1181 (setq marks (gnus-info-marks info)) 1213 (setq marks (gnus-info-marks info))
1182 (dolist (type (cdr nnimap-mark-alist)) 1214 (dolist (type (cdr nnimap-mark-alist))
1183 (when (or (not (listp permanent-flags)) 1215 (when (or (not (listp permanent-flags))
1184 (memq (assoc (caddr type) flags) permanent-flags) 1216 (memq (car (assoc (caddr type) flags))
1217 permanent-flags)
1185 (memq '%* permanent-flags)) 1218 (memq '%* permanent-flags))
1186 (let ((old-marks (assoc (car type) marks)) 1219 (let ((old-marks (assoc (car type) marks))
1187 (new-marks 1220 (new-marks
@@ -1454,12 +1487,14 @@ textual parts.")
1454 (nnimap-wait-for-response sequence) 1487 (nnimap-wait-for-response sequence)
1455 (nnimap-parse-response)) 1488 (nnimap-parse-response))
1456 1489
1457(defun nnimap-wait-for-connection () 1490(defun nnimap-wait-for-connection (&optional regexp)
1491 (unless regexp
1492 (setq regexp "^[*.] .*\n"))
1458 (let ((process (get-buffer-process (current-buffer)))) 1493 (let ((process (get-buffer-process (current-buffer))))
1459 (goto-char (point-min)) 1494 (goto-char (point-min))
1460 (while (and (memq (process-status process) 1495 (while (and (memq (process-status process)
1461 '(open run)) 1496 '(open run))
1462 (not (re-search-forward "^[*.] .*\n" nil t))) 1497 (not (re-search-forward regexp nil t)))
1463 (nnheader-accept-process-output process) 1498 (nnheader-accept-process-output process)
1464 (goto-char (point-min))) 1499 (goto-char (point-min)))
1465 (forward-line -1) 1500 (forward-line -1)
@@ -1593,6 +1628,7 @@ textual parts.")
1593 new-articles) 1628 new-articles)
1594 (erase-buffer) 1629 (erase-buffer)
1595 (nnimap-command "SELECT %S" nnimap-inbox) 1630 (nnimap-command "SELECT %S" nnimap-inbox)
1631 (setf (nnimap-group nnimap-object) nnimap-inbox)
1596 (setq new-articles (nnimap-new-articles (nnimap-get-flags "1:*"))) 1632 (setq new-articles (nnimap-new-articles (nnimap-get-flags "1:*")))
1597 (when new-articles 1633 (when new-articles
1598 (nnimap-fetch-inbox new-articles) 1634 (nnimap-fetch-inbox new-articles)
@@ -1645,7 +1681,7 @@ textual parts.")
1645 (cond 1681 (cond
1646 ;; If the server supports it, we now delete the message we have 1682 ;; If the server supports it, we now delete the message we have
1647 ;; just copied over. 1683 ;; just copied over.
1648 ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) 1684 ((nnimap-capability "UIDPLUS")
1649 (setq sequence (nnimap-send-command "UID EXPUNGE %s" range))) 1685 (setq sequence (nnimap-send-command "UID EXPUNGE %s" range)))
1650 ;; If it doesn't support UID EXPUNGE, then we only expunge if the 1686 ;; If it doesn't support UID EXPUNGE, then we only expunge if the
1651 ;; user has configured it. 1687 ;; user has configured it.
@@ -1665,9 +1701,8 @@ textual parts.")
1665(defun nnimap-new-articles (flags) 1701(defun nnimap-new-articles (flags)
1666 (let (new) 1702 (let (new)
1667 (dolist (elem flags) 1703 (dolist (elem flags)
1668 (when (or (null (cdr elem)) 1704 (unless (gnus-list-memq-of-list nnimap-unsplittable-articles
1669 (and (not (memq '%Deleted (cdr elem))) 1705 (cdr elem))
1670 (not (memq '%Seen (cdr elem)))))
1671 (push (car elem) new))) 1706 (push (car elem) new)))
1672 (gnus-compress-sequence (nreverse new)))) 1707 (gnus-compress-sequence (nreverse new))))
1673 1708
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index a32d748a60c..bfe4df8ee1b 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -32,163 +32,40 @@
32 32
33;; TODO: Documentation in the Gnus manual 33;; TODO: Documentation in the Gnus manual
34 34
35;; From: Reiner Steib 35;; Where in the existing gnus manual would this fit best?
36;; Subject: Re: Including nnir.el
37;; Newsgroups: gmane.emacs.gnus.general
38;; Message-ID: <v9d5dnp6aq.fsf@marauder.physik.uni-ulm.de>
39;; Date: 2006-06-05 22:49:01 GMT
40;;
41;; On Sun, Jun 04 2006, Sascha Wilde wrote:
42;;
43;; > The one thing most hackers like to forget: Documentation. By now the
44;; > documentation is only in the comments at the head of the source, I
45;; > would use it as basis to cook up some minimal texinfo docs.
46;; >
47;; > Where in the existing gnus manual would this fit best?
48
49;; Maybe (info "(gnus)Combined Groups") for a general description.
50;; `gnus-group-make-nnir-group' might be described in (info
51;; "(gnus)Foreign Groups") as well.
52
53
54;; The most recent version of this can always be fetched from the Gnus
55;; repository. See http://www.gnus.org/ for more information.
56
57;; This code is still in the development stage but I'd like other
58;; people to have a look at it. Please do not hesitate to contact me
59;; with your ideas.
60 36
61;; What does it do? Well, it allows you to index your mail using some 37;; What does it do? Well, it allows you to search your mail using
62;; search engine (freeWAIS-sf, swish-e and others -- see later), 38;; some search engine (imap, namazu, swish-e, gmane and others -- see
63;; then type `G G' in the Group buffer and issue a query to the search 39;; later) by typing `G G' in the Group buffer. You will then get a
64;; engine. You will then get a buffer which shows all articles 40;; buffer which shows all articles matching the query, sorted by
65;; matching the query, sorted by Retrieval Status Value (score). 41;; Retrieval Status Value (score).
66 42
67;; When looking at the retrieval result (in the Summary buffer) you 43;; When looking at the retrieval result (in the Summary buffer) you
68;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an 44;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an
69;; article. You will be teleported into the group this article came 45;; article. You will be teleported into the group this article came
70;; from, showing the thread this article is part of. (See below for 46;; from, showing the thread this article is part of.
71;; restrictions.)
72 47
73;; The Lisp installation is simple: just put this file on your 48;; The Lisp setup may involve setting a few variables and setting up the
74;; load-path, byte-compile it, and load it from ~/.gnus or something.
75;; This will install a new command `G G' in your Group buffer for
76;; searching your mail. Note that you also need to configure a number
77;; of variables, as described below.
78
79;; Restrictions:
80;;
81;; * If you don't use HyREX as your search engine, this expects that
82;; you use nnml or another one-file-per-message backend, because the
83;; others doesn't support nnfolder.
84;; * It can only search the mail backend's which are supported by one
85;; search engine, because of different query languages.
86;; * There are restrictions to the Wais setup.
87;; * There are restrictions to the imap setup.
88;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before
89;; limiting to the right articles. This is much too slow, of
90;; course. May issue a query for number of articles to fetch; you
91;; must accept the default of all articles at this point or things
92;; may break.
93
94;; The Lisp setup involves setting a few variables and setting up the
95;; search engine. You can define the variables in the server definition 49;; search engine. You can define the variables in the server definition
96;; like this : 50;; like this :
97;; (setq gnus-secondary-select-methods '( 51;; (setq gnus-secondary-select-methods '(
98;; (nnimap "" (nnimap-address "localhost") 52;; (nnimap "" (nnimap-address "localhost")
99;; (nnir-search-engine hyrex) 53;; (nnir-search-engine namazu)
100;; (nnir-hyrex-additional-switches ("-d" "ddl-nnimap.xml"))
101;; ))) 54;; )))
102;; Or you can define the global ones. The variables set in the mailer- 55;; The main variable to set is `nnir-search-engine'. Choose one of
103;; definition will be used first. 56;; the engines listed in `nnir-engines'. (Actually `nnir-engines' is
104;; The variable to set is `nnir-search-engine'. Choose one of the engines 57;; an alist, type `C-h v nnir-engines RET' for more information; this
105;; listed in `nnir-engines'. (Actually `nnir-engines' is an alist, 58;; includes examples for setting `nnir-search-engine', too.)
106;; type `C-h v nnir-engines RET' for more information; this includes
107;; examples for setting `nnir-search-engine', too.)
108;;
109;; The variable nnir-mail-backend isn't used anymore.
110;;
111 59
112;; You must also set up a search engine. I'll tell you about the two 60;; If you use one of the local indices (namazu, find-grep, swish) you
113;; search engines currently supported: 61;; must also set up a search engine backend.
114 62
115;; 1. freeWAIS-sf 63;; 1. Namazu
116;;
117;; As always with freeWAIS-sf, you need a so-called `format file'. I
118;; use the following file:
119;;
120;; ,-----
121;; | # Kai's format file for freeWAIS-sf for indexing mails.
122;; | # Each mail is in a file, much like the MH format.
123;; |
124;; | # Document separator should never match -- each file is a document.
125;; | record-sep: /^@this regex should never match@$/
126;; |
127;; | # Searchable fields specification.
128;; |
129;; | region: /^[sS]ubject:/ /^[sS]ubject: */
130;; | subject "Subject header" stemming TEXT BOTH
131;; | end: /^[^ \t]/
132;; |
133;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */
134;; | to "To and Cc headers" SOUNDEX BOTH
135;; | end: /^[^ \t]/
136;; |
137;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */
138;; | from "From header" SOUNDEX BOTH
139;; | end: /^[^ \t]/
140;; |
141;; | region: /^$/
142;; | stemming TEXT GLOBAL
143;; | end: /^@this regex should never match@$/
144;; `-----
145;;
146;; 1998-07-22: waisindex would dump core on me for large articles with
147;; the above settings. I used /^$/ as the end regex for the global
148;; field. That seemed to work okay.
149
150;; There is a Perl module called `WAIS.pm' which is available from
151;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl. This
152;; module comes with a nifty tool called `makedb', which I use for
153;; indexing. Here's my `makedb.conf':
154;;
155;; ,-----
156;; | # Config file for makedb
157;; |
158;; | # Global options
159;; | waisindex = /usr/local/bin/waisindex
160;; | wais_opt = -stem -t fields
161;; | # `-stem' option necessary when `stemming' is specified for the
162;; | # global field in the *.fmt file
163;; |
164;; | # Own variables
165;; | homedir = /home/kai
166;; |
167;; | # The mail database.
168;; | database = mail
169;; | files = `find $homedir/Mail -name \*[0-9] -print`
170;; | dbdir = $homedir/.wais
171;; | limit = 100
172;; `-----
173;;
174;; The Lisp setup involves the `nnir-wais-*' variables. The most
175;; difficult to understand variable is probably
176;; `nnir-wais-remove-prefix'. Here's what it does: the output of
177;; `waissearch' basically contains the file name and the (full)
178;; directory name. As Gnus works with group names rather than
179;; directory names, the directory name is transformed into a group
180;; name as follows: first, a prefix is removed from the (full)
181;; directory name, then all `/' are replaced with `.'. The variable
182;; `nnir-wais-remove-prefix' should contain a regex matching exactly
183;; this prefix. It defaults to `$HOME/Mail/' (note the trailing
184;; slash).
185
186;; 2. Namazu
187;; 64;;
188;; The Namazu backend requires you to have one directory containing all 65;; The Namazu backend requires you to have one directory containing all
189;; index files, this is controlled by the `nnir-namazu-index-directory' 66;; index files, this is controlled by the `nnir-namazu-index-directory'
190;; variable. To function the `nnir-namazu-remove-prefix' variable must 67;; variable. To function the `nnir-namazu-remove-prefix' variable must
191;; also be correct, see the documentation for `nnir-wais-remove-prefix' 68;; also be correct, see the documentation for `nnir-namazu-remove-prefix'
192;; above. 69;; above.
193;; 70;;
194;; It is particularly important not to pass any any switches to namazu 71;; It is particularly important not to pass any any switches to namazu
@@ -227,18 +104,7 @@
227;; For maximum searching efficiency I have a cron job set to run this 104;; For maximum searching efficiency I have a cron job set to run this
228;; command every four hours. 105;; command every four hours.
229 106
230;; 3. HyREX 107;; 2. find-grep
231;;
232;; The HyREX backend requires you to have one directory from where all
233;; your relative paths are to, if you use them. This directory must be
234;; set in the `nnir-hyrex-index-directory' variable, which defaults to
235;; your home directory. You must also pass the base, class and
236;; directory options or simply your dll to the `nnir-hyrex-programm' by
237;; setting the `nnir-hyrex-additional-switches' variable accordently.
238;; To function the `nnir-hyrex-remove-prefix' variable must also be
239;; correct, see the documentation for `nnir-wais-remove-prefix' above.
240
241;; 4. find-grep
242;; 108;;
243;; The find-grep engine simply runs find(1) to locate eligible 109;; The find-grep engine simply runs find(1) to locate eligible
244;; articles and searches them with grep(1). This, of course, is much 110;; articles and searches them with grep(1). This, of course, is much
@@ -294,43 +160,14 @@
294;; function should return the list of articles as a vector, as 160;; function should return the list of articles as a vector, as
295;; described above. Then, you need to register this backend in 161;; described above. Then, you need to register this backend in
296;; `nnir-engines'. Then, users can choose the backend by setting 162;; `nnir-engines'. Then, users can choose the backend by setting
297;; `nnir-search-engine'. 163;; `nnir-search-engine' as a server variable.
298
299;; Todo, or future ideas:
300
301;; * It should be possible to restrict search to certain groups.
302;;
303;; * There is currently no error checking.
304;;
305;; * The summary buffer display is currently really ugly, with all the
306;; added information in the subjects. How could I make this
307;; prettier?
308;;
309;; * A function which can be called from an nnir summary buffer which
310;; teleports you into the group the current article came from and
311;; shows you the whole thread this article is part of.
312;; Implementation suggestions?
313;; (1998-07-24: There is now a preliminary implementation, but
314;; it is much too slow and quite fragile.)
315;;
316;; * Support other mail backends. In particular, probably quite a few
317;; people use nnfolder. How would one go about searching nnfolders
318;; and producing the right data needed? The group name and the RSV
319;; are simple, but what about the article number?
320;; - The article number is encoded in the `X-Gnus-Article-Number'
321;; header of each mail.
322;; - The HyREX engine supports nnfolder.
323;;
324;; * Support compressed mail files. Probably, just stripping off the
325;; `.gz' or `.Z' file name extension is sufficient.
326;;
327;; * At least for imap, the query is performed twice.
328;;
329
330;; Have you got other ideas?
331 164
332;;; Setup Code: 165;;; Setup Code:
333 166
167;; For Emacs <22.2 and XEmacs.
168(eval-and-compile
169 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
170
334(require 'nnoo) 171(require 'nnoo)
335(require 'gnus-group) 172(require 'gnus-group)
336(require 'gnus-sum) 173(require 'gnus-sum)
@@ -350,118 +187,27 @@
350 187
351(gnus-declare-backend "nnir" 'mail) 188(gnus-declare-backend "nnir" 'mail)
352 189
353(defvar nnir-imap-default-search-key "Whole message"
354 "The default IMAP search key for an nnir search. Must be one of
355 the keys in nnir-imap-search-arguments. To use raw imap queries
356 by default set this to \"Imap\"")
357
358(defvar nnir-imap-search-arguments
359 '(("Whole message" . "TEXT")
360 ("Subject" . "SUBJECT")
361 ("To" . "TO")
362 ("From" . "FROM")
363 ("Imap" . ""))
364 "Mapping from user readable keys to IMAP search items for use in nnir")
365
366(defvar nnir-imap-search-other "HEADER %S"
367 "The IMAP search item to use for anything other than
368 nnir-imap-search-arguments. By default this is the name of an
369 email header field")
370
371(defvar nnir-imap-search-argument-history ()
372 "The history for querying search options in nnir")
373
374(defvar nnir-get-article-nov-override-function nil
375 "If non-nil, a function that will be passed each search result. This
376should return a message's headers in NOV format.
377
378If this variable is nil, or if the provided function returns nil for a search
379result, `gnus-retrieve-headers' will be called instead.")
380
381(defvar nnir-method-default-engines
382 '((nnimap . imap)
383 (nntp . nil))
384 "Alist of default search engines by server method")
385
386;;; Developer Extension Variable:
387
388(defvar nnir-engines
389 `((wais nnir-run-waissearch
390 ())
391 (imap nnir-run-imap
392 ((criteria
393 "Search in" ; Prompt
394 ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing
395 nil ; allow any user input
396 nil ; initial value
397 nnir-imap-search-argument-history ; the history to use
398 ,nnir-imap-default-search-key ; default
399 )))
400 (swish++ nnir-run-swish++
401 ((group . "Group spec: ")))
402 (swish-e nnir-run-swish-e
403 ((group . "Group spec: ")))
404 (namazu nnir-run-namazu
405 ())
406 (hyrex nnir-run-hyrex
407 ((group . "Group spec: ")))
408 (find-grep nnir-run-find-grep
409 ((grep-options . "Grep options: "))))
410 "Alist of supported search engines.
411Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
412ENGINE is a symbol designating the searching engine. FUNCTION is also
413a symbol, giving the function that does the search. The third element
414ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query,
415the FUNCTION will issue a query for each of the PARAMs, using PROMPT.
416
417The value of `nnir-search-engine' must be one of the ENGINE symbols.
418For example, use the following line for searching using freeWAIS-sf:
419 (setq nnir-search-engine 'wais)
420Use the following line if you read your mail via IMAP and your IMAP
421server supports searching:
422 (setq nnir-search-engine 'imap)
423Note that you have to set additional variables for most backends. For
424example, the `wais' backend needs the variables `nnir-wais-program',
425`nnir-wais-database' and `nnir-wais-remove-prefix'.
426
427Add an entry here when adding a new search engine.")
428 190
429;;; User Customizable Variables: 191;;; User Customizable Variables:
430 192
431(defgroup nnir nil 193(defgroup nnir nil
432 "Search nnmh and nnml groups in Gnus with swish-e, freeWAIS-sf, or EWS." 194 "Search groups in Gnus with assorted seach engines."
433 :group 'gnus) 195 :group 'gnus)
434 196
435;; Mail backend. 197(defcustom nnir-method-default-engines
436 198 '((nnimap . imap)
437;; TODO: 199 (nntp . gmane))
438;; If `nil', use server parameters to find out which server to search. CCC 200 "*Alist of default search engines keyed by server method"
439;; 201 :type '(alist)
440(defcustom nnir-mail-backend '(nnml "")
441 "*Specifies which backend should be searched.
442More precisely, this is used to determine from which backend to fetch the
443messages found.
444
445This must be equal to an existing server, so maybe it is best to use
446something like the following:
447 (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods))
448The above line works fine if the mail backend you want to search is
449the first element of gnus-secondary-select-methods (`nth' starts counting
450at zero)."
451 :type '(sexp)
452 :group 'nnir) 202 :group 'nnir)
453 203
454;; Search engine to use. 204(defcustom nnir-imap-default-search-key "Whole message"
455 205 "*The default IMAP search key for an nnir search. Must be one of
456(defcustom nnir-search-engine 'wais 206 the keys in `nnir-imap-search-arguments'. To use raw imap queries
457 "*The search engine to use. Must be a symbol. 207 by default set this to \"Imap\""
458See `nnir-engines' for a list of supported engines, and for example 208 :type '(string)
459settings of `nnir-search-engine'."
460 :type '(sexp)
461 :group 'nnir) 209 :group 'nnir)
462 210
463;; freeWAIS-sf.
464
465(defcustom nnir-wais-program "waissearch" 211(defcustom nnir-wais-program "waissearch"
466 "*Name of waissearch executable." 212 "*Name of waissearch executable."
467 :type '(string) 213 :type '(string)
@@ -517,8 +263,8 @@ Instead, use this:
517in order to get a group name (albeit with / instead of .). This is a 263in order to get a group name (albeit with / instead of .). This is a
518regular expression. 264regular expression.
519 265
520This variable is very similar to `nnir-wais-remove-prefix', except 266This variable is very similar to `nnir-namazu-remove-prefix', except
521that it is for swish++, not Wais." 267that it is for swish++, not Namazu."
522 :type '(regexp) 268 :type '(regexp)
523 :group 'nnir) 269 :group 'nnir)
524 270
@@ -568,8 +314,8 @@ This could be a server parameter."
568in order to get a group name (albeit with / instead of .). This is a 314in order to get a group name (albeit with / instead of .). This is a
569regular expression. 315regular expression.
570 316
571This variable is very similar to `nnir-wais-remove-prefix', except 317This variable is very similar to `nnir-namazu-remove-prefix', except
572that it is for swish-e, not Wais. 318that it is for swish-e, not Namazu.
573 319
574This could be a server parameter." 320This could be a server parameter."
575 :type '(regexp) 321 :type '(regexp)
@@ -637,11 +383,83 @@ Instead, use this:
637 "*The prefix to remove from each file name returned by Namazu 383 "*The prefix to remove from each file name returned by Namazu
638in order to get a group name (albeit with / instead of .). 384in order to get a group name (albeit with / instead of .).
639 385
640This variable is very similar to `nnir-wais-remove-prefix', except 386For example, suppose that Namazu returns file names such as
641that it is for Namazu, not Wais." 387\"/home/john/Mail/mail/misc/42\". For this example, use the following
388setting: (setq nnir-namazu-remove-prefix \"/home/john/Mail/\")
389Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
390`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
391arrive at the correct group name, \"mail.misc\"."
642 :type '(directory) 392 :type '(directory)
643 :group 'nnir) 393 :group 'nnir)
644 394
395;; Imap variables
396
397(defvar nnir-imap-search-arguments
398 '(("Whole message" . "TEXT")
399 ("Subject" . "SUBJECT")
400 ("To" . "TO")
401 ("From" . "FROM")
402 ("Imap" . ""))
403 "Mapping from user readable keys to IMAP search items for use in nnir")
404
405(defvar nnir-imap-search-other "HEADER %S"
406 "The IMAP search item to use for anything other than
407 `nnir-imap-search-arguments'. By default this is the name of an
408 email header field")
409
410(defvar nnir-imap-search-argument-history ()
411 "The history for querying search options in nnir")
412
413;;; Developer Extension Variable:
414
415(defvar nnir-engines
416 `((wais nnir-run-waissearch
417 ())
418 (imap nnir-run-imap
419 ((criteria
420 "Imap Search in" ; Prompt
421 ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing
422 nil ; allow any user input
423 nil ; initial value
424 nnir-imap-search-argument-history ; the history to use
425 ,nnir-imap-default-search-key ; default
426 )))
427 (gmane nnir-run-gmane
428 ((author . "Gmane Author: ")))
429 (swish++ nnir-run-swish++
430 ((group . "Swish++ Group spec: ")))
431 (swish-e nnir-run-swish-e
432 ((group . "Swish-e Group spec: ")))
433 (namazu nnir-run-namazu
434 ())
435 (hyrex nnir-run-hyrex
436 ((group . "Hyrex Group spec: ")))
437 (find-grep nnir-run-find-grep
438 ((grep-options . "Grep options: "))))
439 "Alist of supported search engines.
440Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
441ENGINE is a symbol designating the searching engine. FUNCTION is also
442a symbol, giving the function that does the search. The third element
443ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query,
444the FUNCTION will issue a query for each of the PARAMs, using PROMPT.
445
446The value of `nnir-search-engine' must be one of the ENGINE symbols.
447For example, for searching a server using namazu include
448 (nnir-search-engine namazu)
449in the server definition. Note that you have to set additional
450variables for most backends. For example, the `namazu' backend
451needs the variables `nnir-namazu-program',
452`nnir-namazu-index-directory' and `nnir-namazu-remove-prefix'.
453
454Add an entry here when adding a new search engine.")
455
456(defvar nnir-get-article-nov-override-function nil
457 "If non-nil, a function that will be passed each search result. This
458should return a message's headers in NOV format.
459
460If this variable is nil, or if the provided function returns nil for a search
461result, `gnus-retrieve-headers' will be called instead.")
462
645;;; Internal Variables: 463;;; Internal Variables:
646 464
647(defvar nnir-current-query nil 465(defvar nnir-current-query nil
@@ -659,43 +477,33 @@ that it is for Namazu, not Wais."
659(defvar nnir-tmp-buffer " *nnir*" 477(defvar nnir-tmp-buffer " *nnir*"
660 "Internal: temporary buffer.") 478 "Internal: temporary buffer.")
661 479
480(defvar nnir-search-history ()
481 "Internal: the history for querying search options in nnir")
482
483(defvar nnir-extra-parms nil
484 "Internal: stores request for extra search parms")
485
662;;; Code: 486;;; Code:
663 487
664;; Gnus glue. 488;; Gnus glue.
665 489
666(defun gnus-group-make-nnir-group (extra-parms query) 490(defun gnus-group-make-nnir-group (nnir-extra-parms)
667 "Create an nnir group. Asks for query." 491 "Create an nnir group. Asks for query."
668 (interactive "P\nsQuery: ") 492 (interactive "P")
669 (setq nnir-current-query nil 493 (setq nnir-current-query nil
670 nnir-current-server nil 494 nnir-current-server nil
671 nnir-current-group-marked nil 495 nnir-current-group-marked nil
672 nnir-artlist nil) 496 nnir-artlist nil)
673 (let ((parms nil)) 497 (let* ((query (read-string "Query: " nil 'nnir-search-history))
674 (if extra-parms 498 (parms (list (cons 'query query)))
675 (setq parms (nnir-read-parms query)) 499 (srv (if (gnus-server-server-name)
676 (setq parms (list (cons 'query query)))) 500 "all" "")))
677 (add-to-list 'parms (cons 'unique-id (message-unique-id)) t) 501 (add-to-list 'parms (cons 'unique-id (message-unique-id)) t)
678 (gnus-group-read-ephemeral-group 502 (gnus-group-read-ephemeral-group
679 (concat "nnir:" (prin1-to-string parms)) '(nnir "") t 503 (concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t
680 (cons (current-buffer) 504 (cons (current-buffer) gnus-current-window-configuration)
681 gnus-current-window-configuration)
682 nil))) 505 nil)))
683 506
684;; Why is this needed? Is this for compatibility with old/new gnusae? Using
685;; gnus-group-server instead works for me. -- Justus Piater
686(defmacro nnir-group-server (group)
687 "Return the server for a newsgroup GROUP.
688The returned format is as `gnus-server-to-method' needs it. See
689`gnus-group-real-prefix' and `gnus-group-real-name'."
690 `(let ((gname ,group))
691 (if (string-match "^\\([^:]+\\):" gname)
692 (progn
693 (setq gname (match-string 1 gname))
694 (if (string-match "^\\([^+]+\\)\\+\\(.+\\)$" gname)
695 (format "%s:%s" (match-string 1 gname) (match-string 2 gname))
696 (concat gname ":")))
697 (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method)))))
698
699;; Summary mode commands. 507;; Summary mode commands.
700 508
701(defun gnus-summary-nnir-goto-thread () 509(defun gnus-summary-nnir-goto-thread ()
@@ -710,22 +518,27 @@ and show thread that contains this article."
710 (id (mail-header-id (gnus-summary-article-header))) 518 (id (mail-header-id (gnus-summary-article-header)))
711 (refs (split-string 519 (refs (split-string
712 (mail-header-references (gnus-summary-article-header))))) 520 (mail-header-references (gnus-summary-article-header)))))
713 (if (eq (car (gnus-group-method group)) 'nnimap) 521 (if (eq (car (gnus-find-method-for-group group)) 'nnimap)
714 (progn (nnimap-possibly-change-group (gnus-group-short-name group) nil) 522 (progn
715 (with-current-buffer (nnimap-buffer) 523 (nnimap-possibly-change-group (gnus-group-short-name group) nil)
716 (let* ((cmd (let ((value (format 524 (with-current-buffer (nnimap-buffer)
717 "(OR HEADER REFERENCES %s HEADER Message-Id %s)" 525 (let* ((cmd
718 id id))) 526 (let ((value
719 (dolist (refid refs value) 527 (format
720 (setq value (format 528 "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
721 "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)" 529 id id)))
722 refid refid value))))) 530 (dolist (refid refs value)
723 (result (nnimap-command 531 (setq value
724 "UID SEARCH %s" cmd))) 532 (format
725 (gnus-summary-read-group-1 group t t gnus-summary-buffer nil 533 "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
726 (and (car result) 534 refid refid value)))))
727 (delete 0 (mapcar #'string-to-number 535 (result (nnimap-command "UID SEARCH %s" cmd)))
728 (cdr (assoc "SEARCH" (cdr result)))))))))) 536 (gnus-summary-read-group-1
537 group t t gnus-summary-buffer nil
538 (and (car result)
539 (delete 0 (mapcar
540 #'string-to-number
541 (cdr (assoc "SEARCH" (cdr result))))))))))
729 (gnus-summary-read-group-1 group t t gnus-summary-buffer 542 (gnus-summary-read-group-1 group t t gnus-summary-buffer
730 nil (list backend-number)) 543 nil (list backend-number))
731 (gnus-summary-limit (list backend-number)) 544 (gnus-summary-limit (list backend-number))
@@ -759,24 +572,19 @@ and show thread that contains this article."
759 (equal server nnir-current-server))) 572 (equal server nnir-current-server)))
760 nnir-artlist 573 nnir-artlist
761 ;; Cache miss. 574 ;; Cache miss.
762 (setq nnir-artlist (nnir-run-query group))) 575 (setq nnir-artlist (nnir-run-query group server)))
763 (with-current-buffer nntp-server-buffer 576 (with-current-buffer nntp-server-buffer
577 (setq nnir-current-query group)
578 (when server (setq nnir-current-server server))
579 (setq nnir-current-group-marked gnus-group-marked)
764 (if (zerop (length nnir-artlist)) 580 (if (zerop (length nnir-artlist))
765 (progn 581 (nnheader-report 'nnir "Search produced empty results.")
766 (setq nnir-current-query nil
767 nnir-current-server nil
768 nnir-current-group-marked nil
769 nnir-artlist nil)
770 (nnheader-report 'nnir "Search produced empty results."))
771 ;; Remember data for cache. 582 ;; Remember data for cache.
772 (setq nnir-current-query group)
773 (when server (setq nnir-current-server server))
774 (setq nnir-current-group-marked gnus-group-marked)
775 (nnheader-insert "211 %d %d %d %s\n" 583 (nnheader-insert "211 %d %d %d %s\n"
776 (nnir-artlist-length nnir-artlist) ; total # 584 (nnir-artlist-length nnir-artlist) ; total #
777 1 ; first # 585 1 ; first #
778 (nnir-artlist-length nnir-artlist) ; last # 586 (nnir-artlist-length nnir-artlist) ; last #
779 group)))) ; group name 587 group)))) ; group name
780 588
781(deffoo nnir-retrieve-headers (articles &optional group server fetch-old) 589(deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
782 (save-excursion 590 (save-excursion
@@ -795,7 +603,7 @@ and show thread that contains this article."
795 (setq artfullgroup (nnir-artitem-group artitem)) 603 (setq artfullgroup (nnir-artitem-group artitem))
796 (setq artno (nnir-artitem-number artitem)) 604 (setq artno (nnir-artitem-number artitem))
797 (setq artgroup (gnus-group-real-name artfullgroup)) 605 (setq artgroup (gnus-group-real-name artfullgroup))
798 (setq server (nnir-group-server artfullgroup)) 606 (setq server (gnus-group-server artfullgroup))
799 ;; retrieve NOV or HEAD data for this article, transform into 607 ;; retrieve NOV or HEAD data for this article, transform into
800 ;; NOV data and prepend to `novdata' 608 ;; NOV data and prepend to `novdata'
801 (set-buffer nntp-server-buffer) 609 (set-buffer nntp-server-buffer)
@@ -909,8 +717,8 @@ ready to be added to the list of search results."
909(defun nnir-run-waissearch (query server &optional group) 717(defun nnir-run-waissearch (query server &optional group)
910 "Run given query agains waissearch. Returns vector of (group name, file name) 718 "Run given query agains waissearch. Returns vector of (group name, file name)
911pairs (also vectors, actually)." 719pairs (also vectors, actually)."
912 (when group 720 ;; (when group
913 (error "The freeWAIS-sf backend cannot search specific groups")) 721 ;; (error "The freeWAIS-sf backend cannot search specific groups"))
914 (save-excursion 722 (save-excursion
915 (let ((qstring (cdr (assq 'query query))) 723 (let ((qstring (cdr (assq 'query query)))
916 (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server)) 724 (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server))
@@ -950,49 +758,50 @@ pairs (also vectors, actually)."
950 (> (nnir-artitem-rsv x) 758 (> (nnir-artitem-rsv x)
951 (nnir-artitem-rsv y))))))))) 759 (nnir-artitem-rsv y)))))))))
952 760
953;; IMAP interface. 761;; imap interface
954;; todo: 762(defun nnir-run-imap (query srv &optional groups)
955;; send queries as literals
956;; handle errors
957
958
959(defun nnir-run-imap (query srv &optional group-option)
960 "Run a search against an IMAP back-end server. 763 "Run a search against an IMAP back-end server.
961This uses a custom query language parser; see `nnir-imap-make-query' for 764This uses a custom query language parser; see `nnir-imap-make-query' for
962details on the language and supported extensions" 765details on the language and supported extensions"
963 (save-excursion 766 (save-excursion
964 (let ((qstring (cdr (assq 'query query))) 767 (let ((qstring (cdr (assq 'query query)))
965 (server (cadr (gnus-server-to-method srv))) 768 (server (cadr (gnus-server-to-method srv)))
966 (group (or group-option (gnus-group-group-name))) 769 (defs (caddr (gnus-server-to-method srv)))
967 (defs (caddr (gnus-server-to-method srv))) 770 (criteria (or (cdr (assq 'criteria query))
968 (criteria (or (cdr (assq 'criteria query)) 771 (cdr (assoc nnir-imap-default-search-key
969 (cdr (assoc nnir-imap-default-search-key 772 nnir-imap-search-arguments))))
970 nnir-imap-search-arguments)))) 773 (gnus-inhibit-demon t)
971 (gnus-inhibit-demon t) 774 (groups (or groups (nnir-get-active srv)))
972 artlist) 775 artlist)
973 (message "Opening server %s" server) 776 (message "Opening server %s" server)
974 (condition-case () 777 (apply
975 (when (nnimap-possibly-change-group (gnus-group-short-name group) server) 778 'vconcat
976 (with-current-buffer (nnimap-buffer) 779 (mapcar
977 (message "Searching %s..." group) 780 (lambda (x)
978 (let ((arts 0) 781 (let ((group x))
979 (result 782 (condition-case ()
980 (nnimap-command "UID SEARCH %s" 783 (when (nnimap-possibly-change-group
981 (if (string= criteria "") 784 (gnus-group-short-name group) server)
982 qstring 785 (with-current-buffer (nnimap-buffer)
983 (nnir-imap-make-query criteria qstring) 786 (message "Searching %s..." group)
984 )))) 787 (let ((arts 0)
985 (mapc 788 (result (nnimap-command "UID SEARCH %s"
986 (lambda (artnum) 789 (if (string= criteria "")
987 (push (vector group artnum 1) artlist) 790 qstring
988 (setq arts (1+ arts))) 791 (nnir-imap-make-query
989 (and (car result) 792 criteria qstring)))))
990 (delete 0 (mapcar #'string-to-number 793 (mapc
991 (cdr (assoc "SEARCH" (cdr result))))))) 794 (lambda (artnum) (push (vector group artnum 1) artlist)
992 (message "Searching %s... %d matches" group arts))) 795 (setq arts (1+ arts)))
993 (message "Searching %s...done" group)) 796 (and (car result)
994 (quit nil)) 797 (delete 0 (mapcar #'string-to-number
995 (reverse artlist)))) 798 (cdr (assoc "SEARCH"
799 (cdr result)))))))
800 (message "Searching %s... %d matches" group arts)))
801 (message "Searching %s...done" group))
802 (quit nil))
803 (reverse artlist)))
804 groups)))))
996 805
997(defun nnir-imap-make-query (criteria qstring) 806(defun nnir-imap-make-query (criteria qstring)
998 "Parse the query string and criteria into an appropriate IMAP search 807 "Parse the query string and criteria into an appropriate IMAP search
@@ -1182,8 +991,8 @@ actually).
1182Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on 991Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on
1183Windows NT 4.0." 992Windows NT 4.0."
1184 993
1185 (when group 994 ;; (when group
1186 (error "The swish++ backend cannot search specific groups")) 995 ;; (error "The swish++ backend cannot search specific groups"))
1187 996
1188 (save-excursion 997 (save-excursion
1189 (let ( (qstring (cdr (assq 'query query))) 998 (let ( (qstring (cdr (assq 'query query)))
@@ -1271,8 +1080,8 @@ actually).
1271Tested with swish-e-2.0.1 on Windows NT 4.0." 1080Tested with swish-e-2.0.1 on Windows NT 4.0."
1272 1081
1273 ;; swish-e crashes with empty parameter to "-w" on commandline... 1082 ;; swish-e crashes with empty parameter to "-w" on commandline...
1274 (when group 1083 ;; (when group
1275 (error "The swish-e backend cannot search specific groups")) 1084 ;; (error "The swish-e backend cannot search specific groups"))
1276 1085
1277 (save-excursion 1086 (save-excursion
1278 (let ((qstring (cdr (assq 'query query))) 1087 (let ((qstring (cdr (assq 'query query)))
@@ -1364,19 +1173,13 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
1364 (qstring (cdr (assq 'query query))) 1173 (qstring (cdr (assq 'query query)))
1365 (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) 1174 (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server))
1366 score artno dirnam) 1175 score artno dirnam)
1367 (when (and group groupspec) 1176 (when (and (not groupspec) group)
1368 (error (concat "It does not make sense to use a group spec" 1177 (setq groupspec
1369 " with process-marked groups."))) 1178 (regexp-opt
1370 (when group 1179 (mapcar (lambda (x) (gnus-group-real-name x)) group))))
1371 (setq groupspec (gnus-group-real-name group)))
1372 (when (and group (not (equal group (nnir-group-full-name groupspec server))))
1373 (message "%s vs. %s" group (nnir-group-full-name groupspec server))
1374 (error "Server with groupspec doesn't match group !"))
1375 (set-buffer (get-buffer-create nnir-tmp-buffer)) 1180 (set-buffer (get-buffer-create nnir-tmp-buffer))
1376 (erase-buffer) 1181 (erase-buffer)
1377 (if groupspec 1182 (message "Doing hyrex-search query %s..." query)
1378 (message "Doing hyrex-search query %s on %s..." query groupspec)
1379 (message "Doing hyrex-search query %s..." query))
1380 (let* ((cp-list 1183 (let* ((cp-list
1381 `( ,nnir-hyrex-program 1184 `( ,nnir-hyrex-program
1382 nil ; input from /dev/null 1185 nil ; input from /dev/null
@@ -1398,16 +1201,14 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
1398 ;; the user wants it. 1201 ;; the user wants it.
1399 (when (> gnus-verbose 6) 1202 (when (> gnus-verbose 6)
1400 (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer ! 1203 (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer !
1401 (if groupspec 1204 (message "Doing hyrex-search query \"%s\"...done" qstring)
1402 (message "Doing hyrex-search query \"%s\" on %s...done" qstring groupspec)
1403 (message "Doing hyrex-search query \"%s\"...done" qstring))
1404 (sit-for 0) 1205 (sit-for 0)
1405 ;; nnir-search returns: 1206 ;; nnir-search returns:
1406 ;; for nnml/nnfolder: "filename mailid weigth" 1207 ;; for nnml/nnfolder: "filename mailid weigth"
1407 ;; for nnimap: "group mailid weigth" 1208 ;; for nnimap: "group mailid weigth"
1408 (goto-char (point-min)) 1209 (goto-char (point-min))
1409 (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") 1210 (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$")
1410 ;; HyREX couldn't search directly in groups -- so filter out here. 1211 ;; HyREX doesn't search directly in groups -- so filter out here.
1411 (when groupspec 1212 (when groupspec
1412 (keep-lines groupspec)) 1213 (keep-lines groupspec))
1413 ;; extract data from result lines 1214 ;; extract data from result lines
@@ -1441,8 +1242,8 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
1441pairs (also vectors, actually). 1242pairs (also vectors, actually).
1442 1243
1443Tested with Namazu 2.0.6 on a GNU/Linux system." 1244Tested with Namazu 2.0.6 on a GNU/Linux system."
1444 (when group 1245 ;; (when group
1445 (error "The Namazu backend cannot search specific groups")) 1246 ;; (error "The Namazu backend cannot search specific groups"))
1446 (save-excursion 1247 (save-excursion
1447 (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir") 1248 (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir")
1448 ":[0-9]+" 1249 ":[0-9]+"
@@ -1504,7 +1305,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
1504 (> (nnir-artitem-rsv x) 1305 (> (nnir-artitem-rsv x)
1505 (nnir-artitem-rsv y))))))))) 1306 (nnir-artitem-rsv y)))))))))
1506 1307
1507(defun nnir-run-find-grep (query server &optional group) 1308(defun nnir-run-find-grep (query server &optional grouplist)
1508 "Run find and grep to obtain matching articles." 1309 "Run find and grep to obtain matching articles."
1509 (let* ((method (gnus-server-to-method server)) 1310 (let* ((method (gnus-server-to-method server))
1510 (sym (intern 1311 (sym (intern
@@ -1516,65 +1317,139 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
1516 (unless directory 1317 (unless directory
1517 (error "No directory found in method specification of server %s" 1318 (error "No directory found in method specification of server %s"
1518 server)) 1319 server))
1519 (message "Searching %s using find-grep..." (or group server)) 1320 (apply
1520 (save-window-excursion 1321 'vconcat
1521 (set-buffer (get-buffer-create nnir-tmp-buffer)) 1322 (mapcar (lambda (x)
1522 (erase-buffer) 1323 (let ((group x))
1523 (if (> gnus-verbose 6) 1324 (message "Searching %s using find-grep..."
1524 (pop-to-buffer (current-buffer))) 1325 (or group server))
1525 (cd directory) ; Using relative paths simplifies postprocessing. 1326 (save-window-excursion
1526 (let ((group 1327 (set-buffer (get-buffer-create nnir-tmp-buffer))
1527 (if (not group) 1328 (erase-buffer)
1528 "." 1329 (if (> gnus-verbose 6)
1529 ;; Try accessing the group literally as well as 1330 (pop-to-buffer (current-buffer)))
1530 ;; interpreting dots as directory separators so the 1331 (cd directory) ; Using relative paths simplifies
1531 ;; engine works with plain nnml as well as the Gnus Cache. 1332 ; postprocessing.
1532 (let ((group (gnus-group-real-name group))) 1333 (let ((group
1533 ;; Replace cl-func find-if. 1334 (if (not group)
1534 (if (file-directory-p group) 1335 "."
1535 group 1336 ;; Try accessing the group literally as
1536 (if (file-directory-p 1337 ;; well as interpreting dots as directory
1537 (setq group (gnus-replace-in-string group "\\." "/" t))) 1338 ;; separators so the engine works with
1538 group)))))) 1339 ;; plain nnml as well as the Gnus Cache.
1539 (unless group 1340 (let ((group (gnus-group-real-name group)))
1540 (error "Cannot locate directory for group")) 1341 ;; Replace cl-func find-if.
1541 (save-excursion 1342 (if (file-directory-p group)
1542 (apply 1343 group
1543 'call-process "find" nil t 1344 (if (file-directory-p
1544 "find" group "-type" "f" "-name" "[0-9]*" "-exec" 1345 (setq group
1545 "grep" 1346 (gnus-replace-in-string
1546 `("-l" ,@(and grep-options 1347 group
1547 (split-string grep-options "\\s-" t)) 1348 "\\." "/" t)))
1548 "-e" ,regexp "{}" "+")))) 1349 group))))))
1549 1350 (unless group
1550 ;; Translate relative paths to group names. 1351 (error "Cannot locate directory for group"))
1551 (while (not (eobp)) 1352 (save-excursion
1552 (let* ((path (split-string 1353 (apply
1553 (buffer-substring (point) (line-end-position)) "/" t)) 1354 'call-process "find" nil t
1554 (art (string-to-number (car (last path))))) 1355 "find" group "-type" "f" "-name" "[0-9]*" "-exec"
1555 (while (string= "." (car path)) 1356 "grep"
1556 (setq path (cdr path))) 1357 `("-l" ,@(and grep-options
1557 (let ((group (mapconcat 'identity 1358 (split-string grep-options "\\s-" t))
1558 ;; Replace cl-func: (subseq path 0 -1) 1359 "-e" ,regexp "{}" "+"))))
1559 (let ((end (1- (length path))) 1360
1560 res) 1361 ;; Translate relative paths to group names.
1561 (while (>= (setq end (1- end)) 0) 1362 (while (not (eobp))
1562 (push (pop path) res)) 1363 (let* ((path (split-string
1563 (nreverse res)) 1364 (buffer-substring
1564 "."))) 1365 (point)
1565 (push (vector (nnir-group-full-name group server) art 0) 1366 (line-end-position)) "/" t))
1566 artlist)) 1367 (art (string-to-number (car (last path)))))
1567 (forward-line 1))) 1368 (while (string= "." (car path))
1568 (message "Searching %s using find-grep...done" (or group server)) 1369 (setq path (cdr path)))
1569 artlist))) 1370 (let ((group (mapconcat 'identity
1371 ;; Replace cl-func:
1372 ;; (subseq path 0 -1)
1373 (let ((end (1- (length path)))
1374 res)
1375 (while
1376 (>= (setq end (1- end)) 0)
1377 (push (pop path) res))
1378 (nreverse res))
1379 ".")))
1380 (push
1381 (vector (nnir-group-full-name group server) art 0)
1382 artlist))
1383 (forward-line 1)))
1384 (message "Searching %s using find-grep...done"
1385 (or group server))
1386 artlist)))
1387 grouplist))))
1388
1389(declare-function mm-url-insert "mm-url" (url &optional follow-refresh))
1390(declare-function mm-url-encode-www-form-urlencoded "mm-url" (pairs))
1391
1392;; gmane interface
1393(defun nnir-run-gmane (query srv &optional groups)
1394 "Run a search against a gmane back-end server."
1395 (if (gnus-string-match-p "gmane" srv)
1396 (let* ((case-fold-search t)
1397 (qstring (cdr (assq 'query query)))
1398 (server (cadr (gnus-server-to-method srv)))
1399 (groupspec (if groups
1400 (mapconcat
1401 (function (lambda (x)
1402 (format "group:%s"
1403 (gnus-group-short-name x))))
1404 groups " ") ""))
1405 (authorspec
1406 (if (assq 'author query)
1407 (format "author:%s" (cdr (assq 'author query))) ""))
1408 (search (format "%s %s %s"
1409 qstring groupspec authorspec))
1410 artlist)
1411 (require 'mm-url)
1412 (with-current-buffer nntp-server-buffer
1413 (erase-buffer)
1414 (mm-url-insert
1415 (concat
1416 "http://search.gmane.org/nov.php"
1417 "?"
1418 (mm-url-encode-www-form-urlencoded
1419 `(("query" . ,search)
1420 ("HITSPERPAGE" . "999")))))
1421 (unless (featurep 'xemacs) (set-buffer-multibyte t))
1422 (mm-decode-coding-region (point-min) (point-max) 'utf-8)
1423 (goto-char (point-min))
1424 (forward-line 1)
1425 (while (not (eobp))
1426 (unless (or (eolp) (looking-at "\x0d"))
1427 (let ((header (nnheader-parse-nov)))
1428 (let ((xref (mail-header-xref header))
1429 (xscore (string-to-number (cdr (assoc 'X-Score
1430 (mail-header-extra header))))))
1431 (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
1432 (push
1433 (vector
1434 (gnus-group-prefixed-name (match-string 1 xref) srv)
1435 (string-to-number (match-string 2 xref)) xscore)
1436 artlist)))))
1437 (forward-line 1)))
1438 ;; Sort by score
1439 (apply 'vector
1440 (sort artlist
1441 (function (lambda (x y)
1442 (> (nnir-artitem-rsv x)
1443 (nnir-artitem-rsv y)))))))
1444 (message "Can't search non-gmane nntp groups")))
1570 1445
1571;;; Util Code: 1446;;; Util Code:
1572 1447
1573(defun nnir-read-parms (query) 1448(defun nnir-read-parms (query nnir-search-engine)
1574 "Reads additional search parameters according to `nnir-engines'." 1449 "Reads additional search parameters according to `nnir-engines'."
1575 (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) 1450 (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines))))
1576 (cons (cons 'query query) 1451 (nconc query
1577 (mapcar 'nnir-read-parm parmspec)))) 1452 (mapcar 'nnir-read-parm parmspec))))
1578 1453
1579(defun nnir-read-parm (parmspec) 1454(defun nnir-read-parm (parmspec)
1580 "Reads a single search parameter. 1455 "Reads a single search parameter.
@@ -1588,69 +1463,45 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
1588 (cons sym (format (cdr mapping) result))) 1463 (cons sym (format (cdr mapping) result)))
1589 (cons sym (read-string prompt))))) 1464 (cons sym (read-string prompt)))))
1590 1465
1591(defun nnir-run-query (query) 1466(defun nnir-run-query (query nserver)
1592 "Invoke appropriate search engine function (see `nnir-engines'). 1467 "Invoke appropriate search engine function (see `nnir-engines').
1593If some groups were process-marked, run the query for each of the groups 1468 If some groups were process-marked, run the query for each of the groups
1594and concat the results." 1469 and concat the results."
1595 (let ((q (car (read-from-string query)))) 1470 (let ((q (car (read-from-string query)))
1596 (if gnus-group-marked 1471 (groups (if (string= "all-ephemeral" nserver)
1597 (apply 'vconcat 1472 (with-current-buffer gnus-server-buffer
1598 (mapcar (lambda (x) 1473 (list (list (gnus-server-server-name))))
1599 (let* ((server (nnir-group-server x)) 1474 (nnir-sort-groups-by-server
1600 (engine 1475 (or gnus-group-marked (list (gnus-group-group-name)))))))
1601 (or (nnir-read-server-parm 'nnir-search-engine 1476 (apply 'vconcat
1602 server) 1477 (mapcar (lambda (x)
1603 (cdr 1478 (let* ((server (car x))
1604 (assoc (car (gnus-server-to-method server)) 1479 (nnir-search-engine
1605 nnir-method-default-engines)))) 1480 (or (nnir-read-server-parm 'nnir-search-engine
1606 search-func) 1481 server)
1607 (setq search-func (cadr 1482 (cdr (assoc (car
1608 (assoc 1483 (gnus-server-to-method server))
1609 engine 1484 nnir-method-default-engines))))
1610 nnir-engines))) 1485 search-func)
1611 (if search-func 1486 (setq search-func (cadr
1612 (funcall search-func q server x) 1487 (assoc nnir-search-engine
1613 nil)))
1614 gnus-group-marked))
1615 (apply 'vconcat
1616 (mapcar (lambda (x)
1617 (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral")))
1618 (let* ((server (format "%s:%s" (caar x) (cadar x)))
1619 (engine
1620 (or (nnir-read-server-parm 'nnir-search-engine
1621 server)
1622 (cdr
1623 (assoc (car (gnus-server-to-method server))
1624 nnir-method-default-engines))))
1625 search-func)
1626 (setq search-func (cadr
1627 (assoc
1628 engine
1629 nnir-engines))) 1488 nnir-engines)))
1630 (if search-func 1489 (if search-func
1631 (funcall search-func q server nil) 1490 (funcall search-func
1632 nil)) 1491 (if nnir-extra-parms
1633 nil)) 1492 (nnir-read-parms q nnir-search-engine)
1634 gnus-opened-servers) 1493 q)
1635 )) 1494 server (cdr x))
1636 )) 1495 nil)))
1496 groups))))
1637 1497
1638(defun nnir-read-server-parm (key server) 1498(defun nnir-read-server-parm (key server)
1639 "Returns the parameter value of for the given server, where server is of 1499 "Returns the parameter value of key for the given server, where
1640form 'backend:name'." 1500server is of form 'backend:name'."
1641 (let ((method (gnus-server-to-method server))) 1501 (let ((method (gnus-server-to-method server)))
1642 (cond ((and method (assq key (cddr method))) 1502 (cond ((and method (assq key (cddr method)))
1643 (nth 1 (assq key (cddr method)))) 1503 (nth 1 (assq key (cddr method))))
1644 ((and nnir-mail-backend 1504 (t nil))))
1645 (gnus-server-equal method nnir-mail-backend))
1646 (symbol-value key))
1647 (t nil))))
1648;; (if method
1649;; (if (assq key (cddr method))
1650;; (nth 1 (assq key (cddr method)))
1651;; (symbol-value key))
1652;; (symbol-value key))
1653;; ))
1654 1505
1655(defun nnir-group-full-name (shortname server) 1506(defun nnir-group-full-name (shortname server)
1656 "For the given group name, return a full Gnus group name. 1507 "For the given group name, return a full Gnus group name.
@@ -1693,8 +1544,8 @@ The Gnus backend/server information is added."
1693 (elt artitem 2)) 1544 (elt artitem 2))
1694 1545
1695(defun nnir-artlist-artitem-rsv (artlist n) 1546(defun nnir-artlist-artitem-rsv (artlist n)
1696 "Returns from ARTLIST the Retrieval Status Value of the Nth artitem 1547 "Returns from ARTLIST the Retrieval Status Value of the Nth
1697\(counting from 1)." 1548artitem (counting from 1)."
1698 (nnir-artitem-rsv (nnir-artlist-article artlist n))) 1549 (nnir-artitem-rsv (nnir-artlist-article artlist n)))
1699 1550
1700;; unused? 1551;; unused?
@@ -1709,6 +1560,55 @@ The Gnus backend/server information is added."
1709 with-dups) 1560 with-dups)
1710 res)) 1561 res))
1711 1562
1563(defun nnir-sort-groups-by-server (groups)
1564 "sorts a list of groups into an alist keyed by server"
1565(if (car groups)
1566 (let (value)
1567 (dolist (var groups value)
1568 (let ((server (gnus-group-server var)))
1569 (if (assoc server value)
1570 (nconc (cdr (assoc server value)) (list var))
1571 (push (cons (gnus-group-server var) (list var)) value))))
1572 value)
1573 nil))
1574
1575(defun nnir-get-active (srv)
1576 (let ((method (gnus-server-to-method srv))
1577 groups)
1578 (gnus-request-list method)
1579 (with-current-buffer nntp-server-buffer
1580 (let ((cur (current-buffer))
1581 name)
1582 (goto-char (point-min))
1583 (unless (string= gnus-ignored-newsgroups "")
1584 (delete-matching-lines gnus-ignored-newsgroups))
1585 ;; We treat NNTP as a special case to avoid problems with
1586 ;; garbage group names like `"foo' that appear in some badly
1587 ;; managed active files. -jh.
1588 (if (eq (car method) 'nntp)
1589 (while (not (eobp))
1590 (ignore-errors
1591 (push (cons
1592 (mm-string-as-unibyte
1593 (buffer-substring
1594 (point)
1595 (progn
1596 (skip-chars-forward "^ \t")
1597 (point))))
1598 (let ((last (read cur)))
1599 (cons (read cur) last)))
1600 groups))
1601 (forward-line))
1602 (while (not (eobp))
1603 (ignore-errors
1604 (push (mm-string-as-unibyte
1605 (let ((p (point)))
1606 (skip-chars-forward "^ \t\\\\")
1607 (setq name (buffer-substring (+ p 1) (- (point) 1)))
1608 (gnus-group-full-name name method)))
1609 groups))
1610 (forward-line)))))
1611 groups))
1712 1612
1713;; The end. 1613;; The end.
1714(provide 'nnir) 1614(provide 'nnir)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 8ccd7b02a16..e5af75419b4 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1,7 +1,8 @@
1;;; nnmail.el --- mail support functions for the Gnus mail backends 1;;; nnmail.el --- mail support functions for the Gnus mail backends
2 2
3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
4;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
5;; Free Software Foundation, Inc.
5 6
6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 7;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7;; Keywords: news, mail 8;; Keywords: news, mail
@@ -1347,7 +1348,7 @@ Eudora has a broken References line, but an OK In-Reply-To."
1347;;; Utility functions 1348;;; Utility functions
1348 1349
1349(declare-function gnus-activate-group "gnus-start" 1350(declare-function gnus-activate-group "gnus-start"
1350 (group &optional scan dont-check method)) 1351 (group &optional scan dont-check method dont-sub-check))
1351 1352
1352(defun nnmail-do-request-post (accept-func &optional server) 1353(defun nnmail-do-request-post (accept-func &optional server)
1353 "Utility function to directly post a message to an nnmail-derived group. 1354 "Utility function to directly post a message to an nnmail-derived group.
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index f63a860875a..7ea2437b956 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1357,7 +1357,7 @@ If ALL is t, return also the unopened/failed ones."
1357 (not (member (car server) gnus-ephemeral-servers)) 1357 (not (member (car server) gnus-ephemeral-servers))
1358 (not (member (gnus-method-to-server (car server)) occ))) 1358 (not (member (gnus-method-to-server (car server)) occ)))
1359 (push 1359 (push
1360 (list mserver) 1360 mserver
1361 openedserver))) 1361 openedserver)))
1362 openedserver)) 1362 openedserver))
1363 1363
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 946025a0af2..46cc0d281a6 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1,8 +1,8 @@
1;;; nntp.el --- nntp access for Gnus 1;;; nntp.el --- nntp access for Gnus
2 2
3;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 3;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996,
4;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 4;; 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 5;; 2009, 2010 Free Software Foundation, Inc.
6 6
7;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 7;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
8;; Keywords: news 8;; Keywords: news
@@ -1172,7 +1172,7 @@ It will make innd servers spawn an nnrpd process to allow actual article
1172reading." 1172reading."
1173 (nntp-send-command "^.*\n" "MODE READER")) 1173 (nntp-send-command "^.*\n" "MODE READER"))
1174 1174
1175(declare-function netrc-parse "netrc" (file)) 1175(declare-function netrc-parse "netrc" (&optional file))
1176(declare-function netrc-machine "netrc" 1176(declare-function netrc-machine "netrc"
1177 (list machine &optional port defaultport)) 1177 (list machine &optional port defaultport))
1178(declare-function netrc-get "netrc" (alist type)) 1178(declare-function netrc-get "netrc" (alist type))
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index 852f6cc826c..cc3855bed04 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -90,6 +90,7 @@ cid: URL as the argument.")
90(defvar shr-list-mode nil) 90(defvar shr-list-mode nil)
91(defvar shr-content-cache nil) 91(defvar shr-content-cache nil)
92(defvar shr-kinsoku-shorten nil) 92(defvar shr-kinsoku-shorten nil)
93(defvar shr-table-depth 0)
93 94
94(defvar shr-map 95(defvar shr-map
95 (let ((map (make-sparse-keymap))) 96 (let ((map (make-sparse-keymap)))
@@ -180,7 +181,7 @@ redirects somewhere else."
180 result)) 181 result))
181 (dolist (sub dom) 182 (dolist (sub dom)
182 (if (stringp sub) 183 (if (stringp sub)
183 (push (cons :text sub) result) 184 (push (cons 'text sub) result)
184 (push (shr-transform-dom sub) result))) 185 (push (shr-transform-dom sub) result)))
185 (nreverse result))) 186 (nreverse result)))
186 187
@@ -193,7 +194,7 @@ redirects somewhere else."
193(defun shr-generic (cont) 194(defun shr-generic (cont)
194 (dolist (sub cont) 195 (dolist (sub cont)
195 (cond 196 (cond
196 ((eq (car sub) :text) 197 ((eq (car sub) 'text)
197 (shr-insert (cdr sub))) 198 (shr-insert (cdr sub)))
198 ((listp (cdr sub)) 199 ((listp (cdr sub))
199 (shr-descend sub))))) 200 (shr-descend sub)))))
@@ -285,7 +286,9 @@ redirects somewhere else."
285 (aref (char-category-set (following-char)) ?>))) 286 (aref (char-category-set (following-char)) ?>)))
286 (backward-char 1)) 287 (backward-char 1))
287 (while (and (>= (setq count (1- count)) 0) 288 (while (and (>= (setq count (1- count)) 0)
288 (aref (char-category-set (following-char)) ?>)) 289 (aref (char-category-set (following-char)) ?>)
290 (aref fill-find-break-point-function-table
291 (following-char)))
289 (forward-char 1))) 292 (forward-char 1)))
290 (when (eq (following-char) ? ) 293 (when (eq (following-char) ? )
291 (forward-char 1)) 294 (forward-char 1))
@@ -369,16 +372,17 @@ redirects somewhere else."
369 (let ((alt (buffer-substring start end)) 372 (let ((alt (buffer-substring start end))
370 (inhibit-read-only t)) 373 (inhibit-read-only t))
371 (delete-region start end) 374 (delete-region start end)
372 (shr-put-image data start alt)))))) 375 (goto-char start)
376 (shr-put-image data alt))))))
373 (kill-buffer (current-buffer))) 377 (kill-buffer (current-buffer)))
374 378
375(defun shr-put-image (data point alt) 379(defun shr-put-image (data alt)
376 (if (not (display-graphic-p)) 380 (if (display-graphic-p)
377 (insert alt) 381 (let ((image (ignore-errors
378 (let ((image (ignore-errors 382 (shr-rescale-image data))))
379 (shr-rescale-image data)))) 383 (when image
380 (when image 384 (insert-image image (or alt "*"))))
381 (put-image image point alt))))) 385 (insert alt)))
382 386
383(defun shr-rescale-image (data) 387(defun shr-rescale-image (data)
384 (if (or (not (fboundp 'imagemagick-types)) 388 (if (or (not (fboundp 'imagemagick-types))
@@ -407,6 +411,10 @@ redirects somewhere else."
407 image))) 411 image)))
408 image))) 412 image)))
409 413
414;; url-cache-extract autoloads url-cache.
415(declare-function url-cache-create-filename "url-cache" (url))
416(autoload 'mm-disable-multibyte "mm-util")
417
410(defun shr-get-image-data (url) 418(defun shr-get-image-data (url)
411 "Get image data for URL. 419 "Get image data for URL.
412Return a string with image data." 420Return a string with image data."
@@ -424,6 +432,8 @@ Return a string with image data."
424 (apply #'shr-fontize-cont cont types) 432 (apply #'shr-fontize-cont cont types)
425 (shr-ensure-paragraph)) 433 (shr-ensure-paragraph))
426 434
435(autoload 'widget-convert-button "wid-edit")
436
427(defun shr-urlify (start url) 437(defun shr-urlify (start url)
428 (widget-convert-button 438 (widget-convert-button
429 'url-link start (point) 439 'url-link start (point)
@@ -468,14 +478,6 @@ Return a string with image data."
468(defun shr-tag-s (cont) 478(defun shr-tag-s (cont)
469 (shr-fontize-cont cont 'strike-through)) 479 (shr-fontize-cont cont 'strike-through))
470 480
471(defun shr-tag-span (cont)
472 (let ((start (point))
473 (color (cdr (assq 'color (shr-parse-style (cdr (assq :style cont)))))))
474 (shr-generic cont)
475 (when color
476 (let ((overlay (make-overlay start (point))))
477 (overlay-put overlay 'face (cons 'foreground-color color))))))
478
479(defun shr-parse-style (style) 481(defun shr-parse-style (style)
480 (when style 482 (when style
481 (let ((plist nil)) 483 (let ((plist nil))
@@ -499,24 +501,43 @@ Return a string with image data."
499 (shr-urlify (or shr-start start) url))) 501 (shr-urlify (or shr-start start) url)))
500 502
501(defun shr-tag-object (cont) 503(defun shr-tag-object (cont)
502 (let ((url (cdr (assq :src (cdr (assq 'embed cont))))) 504 (let ((start (point))
503 (start (point))) 505 url)
506 (dolist (elem cont)
507 (when (eq (car elem) 'embed)
508 (setq url (or url (cdr (assq :src (cdr elem))))))
509 (when (and (eq (car elem) 'param)
510 (equal (cdr (assq :name (cdr elem))) "movie"))
511 (setq url (or url (cdr (assq :value (cdr elem)))))))
504 (when url 512 (when url
505 (shr-insert " [multimedia] ") 513 (shr-insert " [multimedia] ")
506 (shr-urlify start url)))) 514 (shr-urlify start url))
515 (shr-generic cont)))
516
517(defun shr-tag-video (cont)
518 (let ((image (cdr (assq :poster cont)))
519 (url (cdr (assq :src cont)))
520 (start (point)))
521 (shr-tag-img nil image)
522 (shr-urlify start url)))
507 523
508(defun shr-tag-img (cont) 524(defun shr-tag-img (cont &optional url)
509 (when (and cont 525 (when (or url
510 (cdr (assq :src cont))) 526 (and cont
527 (cdr (assq :src cont))))
511 (when (and (> (current-column) 0) 528 (when (and (> (current-column) 0)
512 (not (eq shr-state 'image))) 529 (not (eq shr-state 'image)))
513 (insert "\n")) 530 (insert "\n"))
514 (let ((alt (cdr (assq :alt cont))) 531 (let ((alt (cdr (assq :alt cont)))
515 (url (cdr (assq :src cont)))) 532 (url (or url (cdr (assq :src cont)))))
516 (let ((start (point-marker))) 533 (let ((start (point-marker)))
517 (when (zerop (length alt)) 534 (when (zerop (length alt))
518 (setq alt "[img]")) 535 (setq alt "*"))
519 (cond 536 (cond
537 ((or (member (cdr (assq :height cont)) '("0" "1"))
538 (member (cdr (assq :width cont)) '("0" "1")))
539 ;; Ignore zero-sized or single-pixel images.
540 )
520 ((and (not shr-inhibit-images) 541 ((and (not shr-inhibit-images)
521 (string-match "\\`cid:" url)) 542 (string-match "\\`cid:" url))
522 (let ((url (substring url (match-end 0))) 543 (let ((url (substring url (match-end 0)))
@@ -524,7 +545,7 @@ Return a string with image data."
524 (if (or (not shr-content-function) 545 (if (or (not shr-content-function)
525 (not (setq image (funcall shr-content-function url)))) 546 (not (setq image (funcall shr-content-function url))))
526 (insert alt) 547 (insert alt)
527 (shr-put-image image (point) alt)))) 548 (shr-put-image image alt))))
528 ((or shr-inhibit-images 549 ((or shr-inhibit-images
529 (and shr-blocked-images 550 (and shr-blocked-images
530 (string-match shr-blocked-images url))) 551 (string-match shr-blocked-images url)))
@@ -534,17 +555,17 @@ Return a string with image data."
534 (shr-insert (substring alt 0 8)) 555 (shr-insert (substring alt 0 8))
535 (shr-insert alt)))) 556 (shr-insert alt))))
536 ((url-is-cached (shr-encode-url url)) 557 ((url-is-cached (shr-encode-url url))
537 (shr-put-image (shr-get-image-data url) (point) alt)) 558 (shr-put-image (shr-get-image-data url) alt))
538 (t 559 (t
539 (insert alt) 560 (insert alt)
540 (ignore-errors 561 (ignore-errors
541 (url-retrieve (shr-encode-url url) 'shr-image-fetched 562 (url-retrieve (shr-encode-url url) 'shr-image-fetched
542 (list (current-buffer) start (point-marker)) 563 (list (current-buffer) start (point-marker))
543 t)))) 564 t))))
544 (insert " ")
545 (put-text-property start (point) 'keymap shr-map) 565 (put-text-property start (point) 'keymap shr-map)
546 (put-text-property start (point) 'shr-alt alt) 566 (put-text-property start (point) 'shr-alt alt)
547 (put-text-property start (point) 'shr-image url) 567 (put-text-property start (point) 'shr-image url)
568 (put-text-property start (point) 'help-echo alt)
548 (setq shr-state 'image))))) 569 (setq shr-state 'image)))))
549 570
550(defun shr-tag-pre (cont) 571(defun shr-tag-pre (cont)
@@ -628,6 +649,7 @@ Return a string with image data."
628 (setq cont (or (cdr (assq 'tbody cont)) 649 (setq cont (or (cdr (assq 'tbody cont))
629 cont)) 650 cont))
630 (let* ((shr-inhibit-images t) 651 (let* ((shr-inhibit-images t)
652 (shr-table-depth (1+ shr-table-depth))
631 (shr-kinsoku-shorten t) 653 (shr-kinsoku-shorten t)
632 ;; Find all suggested widths. 654 ;; Find all suggested widths.
633 (columns (shr-column-specs cont)) 655 (columns (shr-column-specs cont))
@@ -649,8 +671,9 @@ Return a string with image data."
649 ;; Finally, insert all the images after the table. The Emacs buffer 671 ;; Finally, insert all the images after the table. The Emacs buffer
650 ;; model isn't strong enough to allow us to put the images actually 672 ;; model isn't strong enough to allow us to put the images actually
651 ;; into the tables. 673 ;; into the tables.
652 (dolist (elem (shr-find-elements cont 'img)) 674 (when (zerop shr-table-depth)
653 (shr-tag-img (cdr elem)))) 675 (dolist (elem (shr-find-elements cont 'img))
676 (shr-tag-img (cdr elem)))))
654 677
655(defun shr-tag-table (cont) 678(defun shr-tag-table (cont)
656 (shr-ensure-paragraph) 679 (shr-ensure-paragraph)
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index 5b5439fab73..a3647061d15 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -1,7 +1,7 @@
1;;; sieve-manage.el --- Implementation of the managesive protocol in elisp 1;;; sieve-manage.el --- Implementation of the managesive protocol in elisp
2 2
3;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 3;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
4;; 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2010 Free Software Foundation, Inc.
5 5
6;; Author: Simon Josefsson <simon@josefsson.org> 6;; Author: Simon Josefsson <simon@josefsson.org>
7 7
@@ -79,6 +79,7 @@
79 (require 'password)) 79 (require 'password))
80 80
81(eval-when-compile 81(eval-when-compile
82 (require 'cl) ; caddr
82 (require 'sasl) 83 (require 'sasl)
83 (require 'starttls)) 84 (require 'starttls))
84(autoload 'sasl-find-mechanism "sasl") 85(autoload 'sasl-find-mechanism "sasl")
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index e28c07ffaad..acb50f11321 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -587,6 +587,9 @@ A string or a list of strings is returned."
587 (kill-buffer digbuf) 587 (kill-buffer digbuf)
588 retbuf)) 588 retbuf))
589 589
590(declare-function ldap-search "ldap"
591 (filter &optional host attributes attrsonly withdn))
592
590(defun smime-cert-by-ldap-1 (mail host) 593(defun smime-cert-by-ldap-1 (mail host)
591 "Get cetificate for MAIL from the ldap server at HOST." 594 "Get cetificate for MAIL from the ldap server at HOST."
592 (let ((ldapresult 595 (let ((ldapresult
@@ -595,7 +598,9 @@ A string or a list of strings is returned."
595 (progn 598 (progn
596 (require 'smime-ldap) 599 (require 'smime-ldap)
597 'smime-ldap-search) 600 'smime-ldap-search)
598 'ldap-search) 601 (progn
602 (require 'ldap)
603 'ldap-search))
599 (concat "mail=" mail) 604 (concat "mail=" mail)
600 host '("userCertificate") nil)) 605 host '("userCertificate") nil))
601 (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) 606 (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
diff --git a/lisp/info.el b/lisp/info.el
index 9b0e87b3c25..163ca258159 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1,8 +1,8 @@
1;; info.el --- info package for Emacs 1;; info.el --- info package for Emacs
2 2
3;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 3;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
4;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 4;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
5;; Free Software Foundation, Inc. 5;; 2010 Free Software Foundation, Inc.
6 6
7;; Maintainer: FSF 7;; Maintainer: FSF
8;; Keywords: help 8;; Keywords: help
@@ -3379,6 +3379,8 @@ Build a menu of the possible matches."
3379(declare-function find-library-name "find-func" (library)) 3379(declare-function find-library-name "find-func" (library))
3380(declare-function finder-unknown-keywords "finder" ()) 3380(declare-function finder-unknown-keywords "finder" ())
3381(declare-function lm-commentary "lisp-mnt" (&optional file)) 3381(declare-function lm-commentary "lisp-mnt" (&optional file))
3382(defvar finder-keywords-hash)
3383(defvar package-alist) ; finder requires package
3382 3384
3383(defun Info-finder-find-node (filename nodename &optional no-going-back) 3385(defun Info-finder-find-node (filename nodename &optional no-going-back)
3384 "Finder-specific implementation of Info-find-node-2." 3386 "Finder-specific implementation of Info-find-node-2."
@@ -4930,5 +4932,4 @@ type returned by `Info-bookmark-make-record', which see."
4930 4932
4931(provide 'info) 4933(provide 'info)
4932 4934
4933;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac
4934;;; info.el ends here 4935;;; info.el ends here
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index f75bbc5eb76..a3a28c3dcfc 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -83,8 +83,8 @@
83 (define-key global-map [menu-bar help-menu] 83 (define-key global-map [menu-bar help-menu]
84 (cons (purecopy "Info") menu-bar-help-menu))) 84 (cons (purecopy "Info") menu-bar-help-menu)))
85 85
86;; This alias is for compatibility with 19.28 and before. 86;; Only declared obsolete (and only made a proper alias) in 23.3.
87(defvar menu-bar-files-menu menu-bar-file-menu) 87(define-obsolete-variable-alias 'menu-bar-files-menu 'menu-bar-file-menu "22.1")
88 88
89;; This is referenced by some code below; it is defined in uniquify.el 89;; This is referenced by some code below; it is defined in uniquify.el
90(defvar uniquify-buffer-name-style) 90(defvar uniquify-buffer-name-style)
@@ -2073,7 +2073,8 @@ With a numeric argument, if the argument is positive,
2073turn on menu bars; otherwise, turn off menu bars." 2073turn on menu bars; otherwise, turn off menu bars."
2074 :init-value t 2074 :init-value t
2075 :global t 2075 :global t
2076 :group 'frames 2076 ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
2077 :variable menu-bar-mode
2077 2078
2078 ;; Turn the menu-bars on all frames on or off. 2079 ;; Turn the menu-bars on all frames on or off.
2079 (let ((val (if menu-bar-mode 1 0))) 2080 (let ((val (if menu-bar-mode 1 0)))
diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el
index f3875e24f07..b9f0011e96f 100644
--- a/lisp/mouse-sel.el
+++ b/lisp/mouse-sel.el
@@ -1,7 +1,7 @@
1;;; mouse-sel.el --- multi-click selection support for Emacs 19 1;;; mouse-sel.el --- multi-click selection support for Emacs 19
2 2
3;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Author: Mike Williams <mdub@bigfoot.com> 6;; Author: Mike Williams <mdub@bigfoot.com>
7;; Keywords: mouse 7;; Keywords: mouse
@@ -299,7 +299,7 @@ where SELECTION-NAME = name of selection
299 SELECTION-THING-SYMBOL = name of variable where the current selection 299 SELECTION-THING-SYMBOL = name of variable where the current selection
300 type for this selection should be stored.") 300 type for this selection should be stored.")
301 301
302(declare-function x-select-text "term/x-win" (text)) 302(declare-function x-select-text "term/common-win" (text))
303 303
304(defvar mouse-sel-set-selection-function 304(defvar mouse-sel-set-selection-function
305 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) 305 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
@@ -314,7 +314,7 @@ Called with two arguments:
314 SELECTION, the name of the selection concerned, and 314 SELECTION, the name of the selection concerned, and
315 VALUE, the text to store. 315 VALUE, the text to store.
316 316
317This sets the selection, unless `mouse-sel-default-bindings' 317This sets the selection, unless `mouse-sel-default-bindings'
318is `interprogram-cut-paste'.") 318is `interprogram-cut-paste'.")
319 319
320(declare-function x-selection-value "term/x-win" ()) 320(declare-function x-selection-value "term/x-win" ())
@@ -749,5 +749,4 @@ If `mouse-yank-at-point' is non-nil, insert at point instead."
749 749
750(provide 'mouse-sel) 750(provide 'mouse-sel)
751 751
752;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7
753;;; mouse-sel.el ends here 752;;; mouse-sel.el ends here
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 00cdcd8ea9b..85c546ffd3f 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -1,4 +1,5 @@
1;;; gnutls.el --- Support SSL/TLS connections through GnuTLS 1;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
2
2;; Copyright (C) 2010 Free Software Foundation, Inc. 3;; Copyright (C) 2010 Free Software Foundation, Inc.
3 4
4;; Author: Ted Zlatanov <tzz@lifelogs.com> 5;; Author: Ted Zlatanov <tzz@lifelogs.com>
@@ -65,6 +66,8 @@ trust and key files, and priority string."
65 (let ((proc (open-network-stream name buffer host service))) 66 (let ((proc (open-network-stream name buffer host service)))
66 (gnutls-negotiate proc 'gnutls-x509pki))) 67 (gnutls-negotiate proc 'gnutls-x509pki)))
67 68
69(declare-function gnutls-boot "gnutls.c" (proc type proplist))
70
68(defun gnutls-negotiate (proc type &optional priority-string 71(defun gnutls-negotiate (proc type &optional priority-string
69 trustfiles keyfiles) 72 trustfiles keyfiles)
70 "Negotiate a SSL/TLS connection. 73 "Negotiate a SSL/TLS connection.
@@ -95,6 +98,9 @@ KEYFILES is a list of client keys."
95 98
96 proc)) 99 proc))
97 100
101(declare-function gnutls-errorp "gnutls.c" (error))
102(declare-function gnutls-error-string "gnutls.c" (error))
103
98(defun gnutls-message-maybe (doit format &rest params) 104(defun gnutls-message-maybe (doit format &rest params)
99 "When DOIT, message with the caller name followed by FORMAT on PARAMS." 105 "When DOIT, message with the caller name followed by FORMAT on PARAMS."
100 ;; (apply 'debug format (or params '(nil))) 106 ;; (apply 'debug format (or params '(nil)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 7b2d8a0a6e6..1ca46d213d3 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2861,7 +2861,11 @@ User is always nil."
2861 (setq buffer-file-name filename) 2861 (setq buffer-file-name filename)
2862 (setq buffer-read-only (not (file-writable-p filename))) 2862 (setq buffer-read-only (not (file-writable-p filename)))
2863 (set-visited-file-modtime) 2863 (set-visited-file-modtime)
2864 (set-buffer-modified-p nil)) 2864 (set-buffer-modified-p nil)
2865 ;; For root, preserve owner and group when editing files.
2866 (when (string-equal (file-remote-p filename 'user) "root")
2867 (set (make-local-variable 'backup-by-copying-when-mismatch) t)
2868 (put 'backup-by-copying-when-mismatch 'permanent-local t)))
2865 (when (and (stringp local-copy) 2869 (when (and (stringp local-copy)
2866 (or remote-copy (null tramp-temp-buffer-file-name))) 2870 (or remote-copy (null tramp-temp-buffer-file-name)))
2867 (delete-file local-copy)) 2871 (delete-file local-copy))
diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el
index 10bf05b2201..e7bd013b2ab 100644
--- a/lisp/play/fortune.el
+++ b/lisp/play/fortune.el
@@ -1,7 +1,7 @@
1;;; fortune.el --- use fortune to create signatures 1;;; fortune.el --- use fortune to create signatures
2 2
3;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 3;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
4;; 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Author: Holger Schauer <Holger.Schauer@gmx.de> 6;; Author: Holger Schauer <Holger.Schauer@gmx.de>
7;; Keywords: games utils mail 7;; Keywords: games utils mail
@@ -285,48 +285,41 @@ and choose the directory as the fortune-file."
285;;; Display fortune 285;;; Display fortune
286(defun fortune-in-buffer (interactive &optional file) 286(defun fortune-in-buffer (interactive &optional file)
287 "Put a fortune cookie in the *fortune* buffer. 287 "Put a fortune cookie in the *fortune* buffer.
288 288INTERACTIVE is ignored. Optional argument FILE, when supplied,
289INTERACTIVE is ignored. Optional argument FILE, 289specifies the file to choose the fortune from."
290when supplied, specifies the file to choose the fortune from."
291 (let ((fortune-buffer (or (get-buffer fortune-buffer-name) 290 (let ((fortune-buffer (or (get-buffer fortune-buffer-name)
292 (generate-new-buffer fortune-buffer-name))) 291 (generate-new-buffer fortune-buffer-name)))
293 (fort-file (expand-file-name 292 (fort-file (expand-file-name
294 (substitute-in-file-name 293 (substitute-in-file-name
295 (or file fortune-file))))) 294 (or file fortune-file)))))
296 (with-current-buffer fortune-buffer 295 (with-current-buffer fortune-buffer
297 (toggle-read-only 0) 296 (let ((inhibit-read-only t))
298 (erase-buffer) 297 (erase-buffer)
299 298 (if fortune-always-compile
300 (if fortune-always-compile 299 (fortune-compile fort-file))
301 (fortune-compile fort-file)) 300 (apply 'call-process
302 301 fortune-program ; program to call
303 (apply 'call-process 302 nil fortune-buffer nil ; INFILE BUFFER DISPLAY
304 fortune-program ; program to call 303 (append (if (stringp fortune-program-options)
305 nil fortune-buffer nil ; INFILE BUFFER DISPLAY 304 (split-string fortune-program-options)
306 (append (if (stringp fortune-program-options) 305 fortune-program-options) (list fort-file)))))))
307 (split-string fortune-program-options)
308 fortune-program-options) (list fort-file))))))
309 306
310;;;###autoload 307;;;###autoload
311(defun fortune (&optional file) 308(defun fortune (&optional file)
312 "Display a fortune cookie. 309 "Display a fortune cookie.
313
314If called with a prefix asks for the FILE to choose the fortune from, 310If called with a prefix asks for the FILE to choose the fortune from,
315otherwise uses the value of `fortune-file'. If you want to have fortune 311otherwise uses the value of `fortune-file'. If you want to have fortune
316choose from a set of files in a directory, call interactively with prefix 312choose from a set of files in a directory, call interactively with prefix
317and choose the directory as the fortune-file." 313and choose the directory as the fortune-file."
318 (interactive 314 (interactive (list (if current-prefix-arg
319 (list 315 (fortune-ask-file)
320 (if current-prefix-arg 316 fortune-file)))
321 (fortune-ask-file)
322 fortune-file)))
323 (fortune-in-buffer t file) 317 (fortune-in-buffer t file)
324 (switch-to-buffer (get-buffer fortune-buffer-name)) 318 (switch-to-buffer (get-buffer fortune-buffer-name))
325 (toggle-read-only 1)) 319 (setq buffer-read-only t))
326 320
327 321
328;;; Provide ourselves. 322;;; Provide ourselves.
329(provide 'fortune) 323(provide 'fortune)
330 324
331;; arch-tag: a1e4cb8a-3792-40e7-86a7-fc75ce094bcc
332;;; fortune.el ends here 325;;; fortune.el ends here
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index dbe3317a020..bb77c5a33ea 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -1,7 +1,7 @@
1;;; gomoku.el --- Gomoku game between you and Emacs 1;;; gomoku.el --- Gomoku game between you and Emacs
2 2
3;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004, 2005, 2006,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr> 6;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
7;; Maintainer: FSF 7;; Maintainer: FSF
@@ -195,8 +195,8 @@ Other useful commands:\n
195\\{gomoku-mode-map}" 195\\{gomoku-mode-map}"
196 (gomoku-display-statistics) 196 (gomoku-display-statistics)
197 (make-local-variable 'font-lock-defaults) 197 (make-local-variable 'font-lock-defaults)
198 (setq font-lock-defaults '(gomoku-font-lock-keywords t)) 198 (setq font-lock-defaults '(gomoku-font-lock-keywords t)
199 (toggle-read-only t)) 199 buffer-read-only t))
200 200
201;;; 201;;;
202;;; THE BOARD. 202;;; THE BOARD.
@@ -1206,5 +1206,4 @@ If the game is finished, this command requests for another game."
1206 1206
1207(provide 'gomoku) 1207(provide 'gomoku)
1208 1208
1209;; arch-tag: b1b8205e-77fc-4597-b373-3ea2c04311eb
1210;;; gomoku.el ends here 1209;;; gomoku.el ends here
diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el
index dd8c554f6f5..9cc73960f6b 100644
--- a/lisp/play/landmark.el
+++ b/lisp/play/landmark.el
@@ -255,8 +255,8 @@ is non-nil. One interesting value is `turn-on-font-lock'."
255 (lm-display-statistics) 255 (lm-display-statistics)
256 (use-local-map lm-mode-map) 256 (use-local-map lm-mode-map)
257 (make-local-variable 'font-lock-defaults) 257 (make-local-variable 'font-lock-defaults)
258 (setq font-lock-defaults '(lm-font-lock-keywords t)) 258 (setq font-lock-defaults '(lm-font-lock-keywords t)
259 (toggle-read-only t) 259 buffer-read-only t)
260 (run-mode-hooks 'lm-mode-hook)) 260 (run-mode-hooks 'lm-mode-hook))
261 261
262 262
@@ -1702,5 +1702,4 @@ Use \\[describe-mode] for more info."
1702 1702
1703(provide 'landmark) 1703(provide 'landmark)
1704 1704
1705;; arch-tag: ae5031be-96e6-459e-a3df-1df53117d3f2
1706;;; landmark.el ends here 1705;;; landmark.el ends here
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 4bbe1e43f85..bc470322ec6 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1,7 +1,8 @@
1;;; ada-mode.el --- major-mode for editing Ada sources 1;;; ada-mode.el --- major-mode for editing Ada sources
2 2
3;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
5;; Free Software Foundation, Inc.
5 6
6;; Author: Rolf Ebert <ebert@inf.enst.fr> 7;; Author: Rolf Ebert <ebert@inf.enst.fr>
7;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> 8;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
@@ -1117,9 +1118,9 @@ the file name."
1117 (funcall (symbol-function 'speedbar-add-supported-extension) 1118 (funcall (symbol-function 'speedbar-add-supported-extension)
1118 spec) 1119 spec)
1119 (funcall (symbol-function 'speedbar-add-supported-extension) 1120 (funcall (symbol-function 'speedbar-add-supported-extension)
1120 body))) 1121 body))))
1121 )
1122 1122
1123(defvar ada-font-lock-syntactic-keywords) ; defined below
1123 1124
1124;;;###autoload 1125;;;###autoload
1125(defun ada-mode () 1126(defun ada-mode ()
@@ -5538,5 +5539,4 @@ This function typically is to be hooked into `ff-file-created-hook'."
5538;;; provide ourselves 5539;;; provide ourselves
5539(provide 'ada-mode) 5540(provide 'ada-mode)
5540 5541
5541;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270
5542;;; ada-mode.el ends here 5542;;; ada-mode.el ends here
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index b17703b0305..112fa50ce8f 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -3974,17 +3974,19 @@ command to conveniently insert and align the necessary backslashes."
3974 ;; "Invalid search bound (wrong side of point)" 3974 ;; "Invalid search bound (wrong side of point)"
3975 ;; error in the subsequent re-search. Maybe 3975 ;; error in the subsequent re-search. Maybe
3976 ;; another fix would be needed (2007-12-08). 3976 ;; another fix would be needed (2007-12-08).
3977 (or (<= (- (cdr c-lit-limits) 2) (point)) 3977; (or (<= (- (cdr c-lit-limits) 2) (point))
3978 (and 3978; 2010-10-17 Construct removed.
3979 (search-forward-regexp 3979; (or (< (- (cdr c-lit-limits) 2) (point))
3980 (concat "\\=[ \t]*\\(" c-current-comment-prefix "\\)") 3980 (and
3981 (- (cdr c-lit-limits) 2) t) 3981 (search-forward-regexp
3982 (not (search-forward-regexp 3982 (concat "\\=[ \t]*\\(" c-current-comment-prefix "\\)")
3983 "\\(\\s \\|\\sw\\)" 3983 (- (cdr c-lit-limits) 2) t)
3984 (- (cdr c-lit-limits) 2) 'limit)) 3984 (not (search-forward-regexp
3985 ;; The comment ender IS on its own line. Exclude 3985 "\\(\\s \\|\\sw\\)"
3986 ;; this line from the filling. 3986 (- (cdr c-lit-limits) 2) 'limit))
3987 (set-marker end (c-point 'bol))))) 3987 ;; The comment ender IS on its own line. Exclude this
3988 ;; line from the filling.
3989 (set-marker end (c-point 'bol))));)
3988 3990
3989 ;; The comment ender is hanging. Replace all space between it 3991 ;; The comment ender is hanging. Replace all space between it
3990 ;; and the last word either by one or two 'x's (when 3992 ;; and the last word either by one or two 'x's (when
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 39501f7f9bc..d2e5657d34a 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1048,6 +1048,9 @@ casts and declarations are fontified. Used on level 2 and higher."
1048 ;; Start of containing declaration (if any); limit for searching 1048 ;; Start of containing declaration (if any); limit for searching
1049 ;; backwards for it. 1049 ;; backwards for it.
1050 decl-start decl-search-lim 1050 decl-start decl-search-lim
1051 ;; Start of containing declaration (if any); limit for searching
1052 ;; backwards for it.
1053 decl-start decl-search-lim
1051 ;; The result from `c-forward-decl-or-cast-1'. 1054 ;; The result from `c-forward-decl-or-cast-1'.
1052 decl-or-cast 1055 decl-or-cast
1053 ;; The maximum of the end positions of all the checked type 1056 ;; The maximum of the end positions of all the checked type
@@ -1318,6 +1321,40 @@ casts and declarations are fontified. Used on level 2 and higher."
1318 1321
1319 nil))) 1322 nil)))
1320 1323
1324(defun c-font-lock-enum-tail (limit)
1325 ;; Fontify an enum's identifiers when POINT is within the enum's brace
1326 ;; block.
1327 ;;
1328 ;; This function will be called from font-lock for a region bounded by POINT
1329 ;; and LIMIT, as though it were to identify a keyword for
1330 ;; font-lock-keyword-face. It always returns NIL to inhibit this and
1331 ;; prevent a repeat invocation. See elisp/lispref page "Search-based
1332 ;; Fontification".
1333 ;;
1334 ;; Note that this function won't attempt to fontify beyond the end of the
1335 ;; current enum block, if any.
1336 (let* ((paren-state (c-parse-state))
1337 (encl-pos (c-most-enclosing-brace paren-state))
1338 (start (point))
1339 )
1340 (when (and
1341 encl-pos
1342 (eq (char-after encl-pos) ?\{)
1343 (save-excursion
1344 (goto-char encl-pos)
1345 (c-backward-syntactic-ws)
1346 (c-simple-skip-symbol-backward)
1347 (or (looking-at c-brace-list-key) ; "enum"
1348 (progn (c-backward-syntactic-ws)
1349 (c-simple-skip-symbol-backward)
1350 (looking-at c-brace-list-key)))))
1351 (c-syntactic-skip-backward "^{," nil t)
1352 (c-put-char-property (1- (point)) 'c-type 'c-decl-id-start)
1353
1354 (c-forward-syntactic-ws)
1355 (c-font-lock-declarators limit t nil)))
1356 nil)
1357
1321(c-lang-defconst c-simple-decl-matchers 1358(c-lang-defconst c-simple-decl-matchers
1322 "Simple font lock matchers for types and declarations. These are used 1359 "Simple font lock matchers for types and declarations. These are used
1323on level 2 only and so aren't combined with `c-complex-decl-matchers'." 1360on level 2 only and so aren't combined with `c-complex-decl-matchers'."
@@ -1582,11 +1619,14 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
1582generic casts and declarations are fontified. Used on level 2 and 1619generic casts and declarations are fontified. Used on level 2 and
1583higher." 1620higher."
1584 1621
1585 t `(;; Fontify the identifiers inside enum lists. (The enum type 1622 t `(,@(when (c-lang-const c-brace-id-list-kwds)
1623 ;; Fontify the remaining identifiers inside an enum list when we start
1624 ;; inside it.
1625 `(c-font-lock-enum-tail
1626 ;; Fontify the identifiers inside enum lists. (The enum type
1586 ;; name is handled by `c-simple-decl-matchers' or 1627 ;; name is handled by `c-simple-decl-matchers' or
1587 ;; `c-complex-decl-matchers' below. 1628 ;; `c-complex-decl-matchers' below.
1588 ,@(when (c-lang-const c-brace-id-list-kwds) 1629 (,(c-make-font-lock-search-function
1589 `((,(c-make-font-lock-search-function
1590 (concat 1630 (concat
1591 "\\<\\(" 1631 "\\<\\("
1592 (c-make-keywords-re nil (c-lang-const c-brace-id-list-kwds)) 1632 (c-make-keywords-re nil (c-lang-const c-brace-id-list-kwds))
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index 40931c3d54d..fdd5e867b7b 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -446,9 +446,6 @@ Non-nil means always go to the next Octave code line after sending."
446 ;; (fundesc (atom "=" atom)) 446 ;; (fundesc (atom "=" atom))
447 )) 447 ))
448 448
449(defconst octave-smie-closer-alist
450 (smie-bnf-closer-alist octave-smie-bnf-table))
451
452(defconst octave-smie-op-levels 449(defconst octave-smie-op-levels
453 (smie-prec2-levels 450 (smie-prec2-levels
454 (smie-merge-prec2s 451 (smie-merge-prec2s
@@ -521,15 +518,18 @@ Non-nil means always go to the next Octave code line after sending."
521 (t 518 (t
522 (smie-default-forward-token)))) 519 (smie-default-forward-token))))
523 520
524(defconst octave-smie-indent-rules 521(defun octave-smie-rules (kind token)
525 '((";" 522 (pcase (cons kind token)
526 (:parent ("function" "if" "while" "else" "elseif" "for" "otherwise" 523 (`(:elem . basic) octave-block-offset)
527 "case" "try" "catch" "unwind_protect" "unwind_protect_cleanup") 524 (`(:before . "case") octave-block-offset)
528 ;; FIXME: don't hardcode 2. 525 (`(:after . ";")
529 (+ parent octave-block-offset)) 526 (if (smie-parent-p "function" "if" "while" "else" "elseif" "for"
530 ;; (:parent "switch" 4) ;For (invalid) code between switch and case. 527 "otherwise" "case" "try" "catch" "unwind_protect"
531 0) 528 "unwind_protect_cleanup")
532 ((:before . "case") octave-block-offset))) 529 '(+ parent octave-block-offset)
530 ;; For (invalid) code between switch and case.
531 ;; (if (smie-parent-p "switch") 4)
532 0))))
533 533
534(defvar electric-indent-chars) 534(defvar electric-indent-chars)
535 535
@@ -619,32 +619,15 @@ already added. You just need to add a description of the problem,
619including a reproducible test case and send the message." 619including a reproducible test case and send the message."
620 (setq local-abbrev-table octave-abbrev-table) 620 (setq local-abbrev-table octave-abbrev-table)
621 621
622 (smie-setup octave-smie-op-levels octave-smie-indent-rules) 622 (smie-setup octave-smie-op-levels #'octave-smie-rules
623 :forward-token #'octave-smie-forward-token
624 :backward-token #'octave-smie-backward-token)
623 (set (make-local-variable 'smie-indent-basic) 'octave-block-offset) 625 (set (make-local-variable 'smie-indent-basic) 'octave-block-offset)
624 (set (make-local-variable 'smie-backward-token-function) 626
625 'octave-smie-backward-token)
626 (set (make-local-variable 'smie-forward-token-function)
627 'octave-smie-forward-token)
628 (set (make-local-variable 'forward-sexp-function)
629 'smie-forward-sexp-command)
630 (set (make-local-variable 'smie-closer-alist) octave-smie-closer-alist)
631 ;; Only needed for interactive calls to blink-matching-open.
632 (set (make-local-variable 'blink-matching-check-function)
633 #'smie-blink-matching-check)
634
635 (when octave-blink-matching-block
636 (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local)
637 (set (make-local-variable 'smie-blink-matching-triggers) 627 (set (make-local-variable 'smie-blink-matching-triggers)
638 (append smie-blink-matching-triggers '(\;) 628 (cons ?\; smie-blink-matching-triggers))
639 ;; Rather than wait for SPC or ; to blink, try to blink as 629 (unless octave-blink-matching-block
640 ;; soon as we type the last char of a block ender. 630 (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local))
641 ;; But strip ?d from this list so that we don't blink twice
642 ;; when the user writes "endif" (once at "end" and another
643 ;; time at "endif").
644 (delq ?d (delete-dups
645 (mapcar (lambda (kw)
646 (aref (cdr kw) (1- (length (cdr kw)))))
647 smie-closer-alist))))))
648 631
649 (set (make-local-variable 'electric-indent-chars) 632 (set (make-local-variable 'electric-indent-chars)
650 (cons ?\; electric-indent-chars)) 633 (cons ?\; electric-indent-chars))
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index f3db7fad135..3e388dac56d 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -173,10 +173,11 @@ When nil, send actual operating system end of file."
173 ) 173 )
174 "Precedence levels of infix operators.") 174 "Precedence levels of infix operators.")
175 175
176(defconst prolog-smie-indent-rules 176(defun prolog-smie-rules (kind token)
177 '((":-") 177 (pcase (cons kind token)
178 ("->")) 178 (`(:elem . basic) prolog-indent-width)
179 "Prolog indentation rules.") 179 (`(:after . ".") 0) ;; To work around smie-closer-alist.
180 (`(:after . ,(or `":-" `"->")) prolog-indent-width)))
180 181
181(defun prolog-mode-variables () 182(defun prolog-mode-variables ()
182 (make-local-variable 'paragraph-separate) 183 (make-local-variable 'paragraph-separate)
@@ -185,19 +186,17 @@ When nil, send actual operating system end of file."
185 (setq paragraph-ignore-fill-prefix t) 186 (setq paragraph-ignore-fill-prefix t)
186 (make-local-variable 'imenu-generic-expression) 187 (make-local-variable 'imenu-generic-expression)
187 (setq imenu-generic-expression '((nil "^\\sw+" 0))) 188 (setq imenu-generic-expression '((nil "^\\sw+" 0)))
188 (smie-setup prolog-smie-op-levels prolog-smie-indent-rules) 189
189 (set (make-local-variable 'smie-forward-token-function) 190 ;; Setup SMIE.
190 #'prolog-smie-forward-token) 191 (smie-setup prolog-smie-op-levels #'prolog-smie-rules
191 (set (make-local-variable 'smie-backward-token-function) 192 :forward-token #'prolog-smie-forward-token
192 #'prolog-smie-backward-token) 193 :backward-token #'prolog-smie-backward-token)
193 (set (make-local-variable 'forward-sexp-function)
194 'smie-forward-sexp-command)
195 (set (make-local-variable 'smie-indent-basic) prolog-indent-width)
196 (set (make-local-variable 'smie-blink-matching-triggers) '(?.)) 194 (set (make-local-variable 'smie-blink-matching-triggers) '(?.))
197 (set (make-local-variable 'smie-closer-alist) '((t . "."))) 195 (set (make-local-variable 'smie-closer-alist) '((t . ".")))
198 (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local) 196 (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local)
199 ;; There's no real closer in Prolog anyway. 197 ;; There's no real closer in Prolog anyway.
200 (set (make-local-variable 'smie-blink-matching-inners) t) 198 (set (make-local-variable 'smie-blink-matching-inners) t)
199
201 (make-local-variable 'comment-start) 200 (make-local-variable 'comment-start)
202 (setq comment-start "%") 201 (setq comment-start "%")
203 (make-local-variable 'comment-start-skip) 202 (make-local-variable 'comment-start-skip)
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index af68699f2a4..fcd0242a10d 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1,7 +1,7 @@
1;;; ruby-mode.el --- Major mode for editing Ruby files 1;;; ruby-mode.el --- Major mode for editing Ruby files
2 2
3;; Copyright (C) 1994, 1995, 1996 1997, 1998, 1999, 2000, 2001, 3;; Copyright (C) 1994, 1995, 1996 1997, 1998, 1999, 2000, 2001, 2002,
4;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 4;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
5;; Free Software Foundation, Inc. 5;; Free Software Foundation, Inc.
6 6
7;; Authors: Yukihiro Matsumoto 7;; Authors: Yukihiro Matsumoto
@@ -1108,6 +1108,8 @@ See `add-log-current-defun-function'."
1108 (if mlist (concat mlist mname) mname) 1108 (if mlist (concat mlist mname) mname)
1109 mlist))))) 1109 mlist)))))
1110 1110
1111(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit))
1112
1111(if (eval-when-compile (fboundp #'syntax-propertize-rules)) 1113(if (eval-when-compile (fboundp #'syntax-propertize-rules))
1112 ;; New code that works independently from font-lock. 1114 ;; New code that works independently from font-lock.
1113 (progn 1115 (progn
@@ -1162,7 +1164,7 @@ See `add-log-current-defun-function'."
1162 ;; inf-loop. 1164 ;; inf-loop.
1163 (if (< (point) start) (goto-char start)))))) 1165 (if (< (point) start) (goto-char start))))))
1164 ) 1166 )
1165 1167
1166 ;; For Emacsen where syntax-propertize-rules is not (yet) available, 1168 ;; For Emacsen where syntax-propertize-rules is not (yet) available,
1167 ;; fallback on the old font-lock-syntactic-keywords stuff. 1169 ;; fallback on the old font-lock-syntactic-keywords stuff.
1168 1170
@@ -1478,5 +1480,4 @@ The variable `ruby-indent-level' controls the amount of indentation.
1478 1480
1479(provide 'ruby-mode) 1481(provide 'ruby-mode)
1480 1482
1481;; arch-tag: e6ecc893-8005-420c-b7f9-34ab99a1fff9
1482;;; ruby-mode.el ends here 1483;;; ruby-mode.el ends here
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 7148027f487..acb34eacc2b 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -7,7 +7,8 @@
7;; Maintainer: Michael Mauger <mmaug@yahoo.com> 7;; Maintainer: Michael Mauger <mmaug@yahoo.com>
8;; Version: 2.8 8;; Version: 2.8
9;; Keywords: comm languages processes 9;; Keywords: comm languages processes
10;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el 10;; URL: http://savannah.gnu.org/projects/emacs/
11;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
11 12
12;; This file is part of GNU Emacs. 13;; This file is part of GNU Emacs.
13 14
@@ -4270,6 +4271,5 @@ buffer.
4270 4271
4271(provide 'sql) 4272(provide 'sql)
4272 4273
4273;; arch-tag: 7e1fa1c4-9ca2-402e-87d2-83a5eccb7ac3
4274;;; sql.el ends here 4274;;; sql.el ends here
4275 4275
diff --git a/lisp/select.el b/lisp/select.el
index 23541963438..0f43ce05822 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -75,8 +75,9 @@ After the communication, this variable is set to nil.")
75(declare-function x-get-selection-internal "xselect.c" 75(declare-function x-get-selection-internal "xselect.c"
76 (selection-symbol target-type &optional time-stamp)) 76 (selection-symbol target-type &optional time-stamp))
77 77
78;; This is for temporary compatibility with pre-release Emacs 19. 78;; Only declared obsolete in 23.3.
79(defalias 'x-selection 'x-get-selection) 79(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34")
80
80(defun x-get-selection (&optional type data-type) 81(defun x-get-selection (&optional type data-type)
81 "Return the value of an X Windows selection. 82 "Return the value of an X Windows selection.
82The argument TYPE (default `PRIMARY') says which selection, 83The argument TYPE (default `PRIMARY') says which selection,
diff --git a/lisp/simple.el b/lisp/simple.el
index 0d5638158fe..4d6d42f55a2 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1,8 +1,8 @@
1;;; simple.el --- basic editing commands for Emacs 1;;; simple.el --- basic editing commands for Emacs
2 2
3;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 3;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998,
4;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 4;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
5;; Free Software Foundation, Inc. 5;; 2010 Free Software Foundation, Inc.
6 6
7;; Maintainer: FSF 7;; Maintainer: FSF
8;; Keywords: internal 8;; Keywords: internal
@@ -4051,29 +4051,8 @@ Invoke \\[apropos-documentation] and type \"transient\" or
4051\"mark.*active\" at the prompt, to see the documentation of 4051\"mark.*active\" at the prompt, to see the documentation of
4052commands which are sensitive to the Transient Mark mode." 4052commands which are sensitive to the Transient Mark mode."
4053 :global t 4053 :global t
4054 :init-value (not noninteractive) 4054 ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
4055 :initialize 'custom-initialize-delay 4055 :variable transient-mark-mode)
4056 :group 'editing-basics)
4057
4058;; The variable transient-mark-mode is ugly: it can take on special
4059;; values. Document these here.
4060(defvar transient-mark-mode t
4061 "*Non-nil if Transient Mark mode is enabled.
4062See the command `transient-mark-mode' for a description of this minor mode.
4063
4064Non-nil also enables highlighting of the region whenever the mark is active.
4065The variable `highlight-nonselected-windows' controls whether to highlight
4066all windows or just the selected window.
4067
4068If the value is `lambda', that enables Transient Mark mode temporarily.
4069After any subsequent action that would normally deactivate the mark
4070\(such as buffer modification), Transient Mark mode is turned off.
4071
4072If the value is (only . OLDVAL), that enables Transient Mark mode
4073temporarily. After any subsequent point motion command that is not
4074shift-translated, or any other action that would normally deactivate
4075the mark (such as buffer modification), the value of
4076`transient-mark-mode' is set to OLDVAL.")
4077 4056
4078(defvar widen-automatically t 4057(defvar widen-automatically t
4079 "Non-nil means it is ok for commands to call `widen' when they want to. 4058 "Non-nil means it is ok for commands to call `widen' when they want to.
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 5e732b398f3..0719f895fad 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,7 +1,8 @@
1;;; speedbar --- quick access to files and tags in a frame 1;;; speedbar --- quick access to files and tags in a frame
2 2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2005, 2006, 2007, 2008, 2009, 2010
5;; Free Software Foundation, Inc.
5 6
6;; Author: Eric M. Ludlam <zappo@gnu.org> 7;; Author: Eric M. Ludlam <zappo@gnu.org>
7;; Keywords: file, tags, tools 8;; Keywords: file, tags, tools
@@ -1128,9 +1129,9 @@ in the selected file.
1128 (setq font-lock-keywords nil) ;; no font-locking please 1129 (setq font-lock-keywords nil) ;; no font-locking please
1129 (setq truncate-lines t) 1130 (setq truncate-lines t)
1130 (make-local-variable 'frame-title-format) 1131 (make-local-variable 'frame-title-format)
1131 (setq frame-title-format (concat "Speedbar " speedbar-version)) 1132 (setq frame-title-format (concat "Speedbar " speedbar-version)
1132 (setq case-fold-search nil) 1133 case-fold-search nil
1133 (toggle-read-only 1) 1134 buffer-read-only t)
1134 (speedbar-set-mode-line-format) 1135 (speedbar-set-mode-line-format)
1135 ;; Add in our dframe hooks. 1136 ;; Add in our dframe hooks.
1136 (if speedbar-track-mouse-flag 1137 (if speedbar-track-mouse-flag
@@ -4142,5 +4143,4 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
4142;; run load-time hooks 4143;; run load-time hooks
4143(run-hooks 'speedbar-load-hook) 4144(run-hooks 'speedbar-load-hook)
4144 4145
4145;; arch-tag: 4477e6d1-f78c-48b9-a503-387d3c9767d5
4146;;; speedbar ends here 4146;;; speedbar ends here
diff --git a/lisp/startup.el b/lisp/startup.el
index 7626dcfac16..5343da65a10 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1,7 +1,7 @@
1;;; startup.el --- process Emacs shell arguments 1;;; startup.el --- process Emacs shell arguments
2 2
3;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 3;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999,
4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 4;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
5;; Free Software Foundation, Inc. 5;; Free Software Foundation, Inc.
6 6
7;; Maintainer: FSF 7;; Maintainer: FSF
@@ -691,6 +691,9 @@ opening the first frame (e.g. open a connection to an X server).")
691 691
692(defvar server-name) 692(defvar server-name)
693(defvar server-process) 693(defvar server-process)
694;; Autoload in package.el, but when we bootstrap, we don't have loaddefs yet.
695(defvar package-enable-at-startup)
696(declare-function package-initialize "package" ())
694 697
695(defun command-line () 698(defun command-line ()
696 (setq before-init-time (current-time) 699 (setq before-init-time (current-time)
@@ -1172,8 +1175,30 @@ the `--debug-init' option to view a complete error backtrace."
1172 (eq face-ignored-fonts old-face-ignored-fonts)) 1175 (eq face-ignored-fonts old-face-ignored-fonts))
1173 (clear-face-cache))) 1176 (clear-face-cache)))
1174 1177
1175 ;; Load ELPA packages. 1178 ;; If any package directory exists, initialize the package system.
1176 (and user-init-file package-enable-at-startup (package-initialize)) 1179 (and user-init-file
1180 package-enable-at-startup
1181 (catch 'package-dir-found
1182 (let (dirs)
1183 (if (boundp 'package-directory-list)
1184 (setq dirs package-directory-list)
1185 (dolist (f load-path)
1186 (and (stringp f)
1187 (equal (file-name-nondirectory f) "site-lisp")
1188 (push (expand-file-name "elpa" f) dirs))))
1189 (push (if (boundp 'package-user-dir)
1190 package-user-dir
1191 (locate-user-emacs-file "elpa"))
1192 dirs)
1193 (dolist (dir dirs)
1194 (when (file-directory-p dir)
1195 (dolist (subdir (directory-files dir))
1196 (when (and (file-directory-p (expand-file-name subdir dir))
1197 ;; package-subdirectory-regexp from package.el
1198 (string-match "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$"
1199 subdir))
1200 (throw 'package-dir-found t)))))))
1201 (package-initialize))
1177 1202
1178 (setq after-init-time (current-time)) 1203 (setq after-init-time (current-time))
1179 (run-hooks 'after-init-hook) 1204 (run-hooks 'after-init-hook)
@@ -2359,5 +2384,4 @@ A fancy display is used on graphic displays, normal otherwise."
2359 (setq file (replace-match "/" t t file))) 2384 (setq file (replace-match "/" t t file)))
2360 file)) 2385 file))
2361 2386
2362;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db
2363;;; startup.el ends here 2387;;; startup.el ends here
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index 5da8b84d3f4..0d3aa934b9b 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -45,7 +45,7 @@
45 ("white" 15 65535 65535 65535)) 45 ("white" 15 65535 65535 65535))
46"A list of VGA console colors, their indices and 16-bit RGB values.") 46"A list of VGA console colors, their indices and 16-bit RGB values.")
47 47
48(declare-function x-setup-function-keys "w32-fns" (frame)) 48(declare-function x-setup-function-keys "term/common-win" (frame))
49 49
50(defun terminal-init-w32console () 50(defun terminal-init-w32console ()
51 "Terminal initialization function for w32 console." 51 "Terminal initialization function for w32 console."
@@ -62,4 +62,4 @@
62 (tty-set-up-initial-frame-faces) 62 (tty-set-up-initial-frame-faces)
63 (run-hooks 'terminal-init-w32-hook)) 63 (run-hooks 'terminal-init-w32-hook))
64 64
65;; arch-tag: 3195fd5e-ab86-4a46-b1dc-4f7a8c8deff3 65;;; w32console.el ends here
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index bd426012532..afb706ab972 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1279,6 +1279,13 @@ The value nil is the same as this list:
1279(setq interprogram-cut-function 'x-select-text) 1279(setq interprogram-cut-function 'x-select-text)
1280(setq interprogram-paste-function 'x-selection-value) 1280(setq interprogram-paste-function 'x-selection-value)
1281 1281
1282;; Make paste from other applications use the decoding in x-select-request-type
1283;; and not just STRING.
1284(defun x-get-selection-value ()
1285 "Get the current value of the PRIMARY selection.
1286Request data types in the order specified by `x-select-request-type'."
1287 (x-selection-value-internal 'PRIMARY))
1288
1282(defun x-clipboard-yank () 1289(defun x-clipboard-yank ()
1283 "Insert the clipboard contents, or the last stretch of killed text." 1290 "Insert the clipboard contents, or the last stretch of killed text."
1284 (interactive "*") 1291 (interactive "*")
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 0662acf2c50..75dd4f80153 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,7 +1,8 @@
1;;; bibtex.el --- BibTeX mode for GNU Emacs 1;;; bibtex.el --- BibTeX mode for GNU Emacs
2 2
3;; Copyright (C) 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002, 3;; Copyright (C) 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002,
4;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
5;; Free Software Foundation, Inc.
5 6
6;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> 7;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
7;; Bengt Martensson <bengt@mathematik.uni-Bremen.de> 8;; Bengt Martensson <bengt@mathematik.uni-Bremen.de>
@@ -3835,16 +3836,16 @@ Return t if test was successful, nil otherwise."
3835 (with-current-buffer (get-buffer-create err-buf) 3836 (with-current-buffer (get-buffer-create err-buf)
3836 (setq default-directory dir) 3837 (setq default-directory dir)
3837 (unless (eq major-mode 'compilation-mode) (compilation-mode)) 3838 (unless (eq major-mode 'compilation-mode) (compilation-mode))
3838 (toggle-read-only -1) 3839 (let ((inhibit-read-only t))
3839 (delete-region (point-min) (point-max)) 3840 (delete-region (point-min) (point-max))
3840 (insert "BibTeX mode command `bibtex-validate'\n" 3841 (insert "BibTeX mode command `bibtex-validate'\n"
3841 (if syntax-error 3842 (if syntax-error
3842 "Maybe undetected errors due to syntax errors. Correct and validate again.\n" 3843 "Maybe undetected errors due to syntax errors. \
3843 "\n")) 3844Correct and validate again.\n"
3844 (dolist (err error-list) 3845 "\n"))
3845 (insert (format "%s:%d: %s\n" file (car err) (cdr err)))) 3846 (dolist (err error-list)
3846 (set-buffer-modified-p nil) 3847 (insert (format "%s:%d: %s\n" file (car err) (cdr err))))
3847 (toggle-read-only 1) 3848 (set-buffer-modified-p nil))
3848 (goto-char (point-min)) 3849 (goto-char (point-min))
3849 (forward-line 2)) ; first error message 3850 (forward-line 2)) ; first error message
3850 (display-buffer err-buf) 3851 (display-buffer err-buf)
@@ -3896,12 +3897,11 @@ Return t if test was successful, nil otherwise."
3896 (let ((err-buf "*BibTeX validation errors*")) 3897 (let ((err-buf "*BibTeX validation errors*"))
3897 (with-current-buffer (get-buffer-create err-buf) 3898 (with-current-buffer (get-buffer-create err-buf)
3898 (unless (eq major-mode 'compilation-mode) (compilation-mode)) 3899 (unless (eq major-mode 'compilation-mode) (compilation-mode))
3899 (toggle-read-only -1) 3900 (let ((inhibit-read-only t))
3900 (delete-region (point-min) (point-max)) 3901 (delete-region (point-min) (point-max))
3901 (insert "BibTeX mode command `bibtex-validate-globally'\n\n") 3902 (insert "BibTeX mode command `bibtex-validate-globally'\n\n")
3902 (dolist (err (sort error-list 'string-lessp)) (insert err)) 3903 (dolist (err (sort error-list 'string-lessp)) (insert err))
3903 (set-buffer-modified-p nil) 3904 (set-buffer-modified-p nil))
3904 (toggle-read-only 1)
3905 (goto-char (point-min)) 3905 (goto-char (point-min))
3906 (forward-line 2)) ; first error message 3906 (forward-line 2)) ; first error message
3907 (display-buffer err-buf) 3907 (display-buffer err-buf)
@@ -4778,5 +4778,4 @@ Return the URL or nil if none can be generated."
4778 4778
4779(provide 'bibtex) 4779(provide 'bibtex)
4780 4780
4781;; arch-tag: ee2be3af-caad-427f-b42a-d20fad630d04
4782;;; bibtex.el ends here 4781;;; bibtex.el ends here
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index d1dd5b05723..b75b232b43c 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1,7 +1,8 @@
1;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 1;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
2 2
3;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 3;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
4;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
5;; Free Software Foundation, Inc.
5 6
6;; Author: Ken Stevens <k.stevens@ieee.org> 7;; Author: Ken Stevens <k.stevens@ieee.org>
7;; Maintainer: Ken Stevens <k.stevens@ieee.org> 8;; Maintainer: Ken Stevens <k.stevens@ieee.org>
@@ -3896,6 +3897,9 @@ Both should not be used to define a buffer-local dictionary."
3896 3897
3897;;; returns optionally adjusted region-end-point. 3898;;; returns optionally adjusted region-end-point.
3898 3899
3900;; If comment-padright is defined, newcomment must be loaded.
3901(declare-function comment-add "newcomment" (arg))
3902
3899(defun ispell-add-per-file-word-list (word) 3903(defun ispell-add-per-file-word-list (word)
3900 "Add WORD to the per-file word list." 3904 "Add WORD to the per-file word list."
3901 (or ispell-buffer-local-name 3905 (or ispell-buffer-local-name
@@ -3970,5 +3974,4 @@ Both should not be used to define a buffer-local dictionary."
3970; LocalWords: uuencoded unidiff sc nn VM SGML eval IspellPersDict unsplitable 3974; LocalWords: uuencoded unidiff sc nn VM SGML eval IspellPersDict unsplitable
3971; LocalWords: lns XEmacs HTML casechars Multibyte 3975; LocalWords: lns XEmacs HTML casechars Multibyte
3972 3976
3973;; arch-tag: 4941b9f9-3b7c-4a76-a4ed-5fa8b6010ef5
3974;;; ispell.el ends here 3977;;; ispell.el ends here
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 4dedf3dfca5..6630d85cd3e 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -1,8 +1,8 @@
1;;; tool-bar.el --- setting up the tool bar 1;;; tool-bar.el --- setting up the tool bar
2;; 2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2009, 2010 Free Software Foundation, Inc.
5;; 5
6;; Author: Dave Love <fx@gnu.org> 6;; Author: Dave Love <fx@gnu.org>
7;; Keywords: mouse frames 7;; Keywords: mouse frames
8;; Package: emacs 8;; Package: emacs
@@ -51,8 +51,8 @@ See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for
51conveniently adding tool bar items." 51conveniently adding tool bar items."
52 :init-value t 52 :init-value t
53 :global t 53 :global t
54 :group 'mouse 54 ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
55 :group 'frames 55 :variable tool-bar-mode
56 (let ((val (if tool-bar-mode 1 0))) 56 (let ((val (if tool-bar-mode 1 0)))
57 (dolist (frame (frame-list)) 57 (dolist (frame (frame-list))
58 (set-frame-parameter frame 'tool-bar-lines val)) 58 (set-frame-parameter frame 'tool-bar-lines val))
@@ -325,10 +325,10 @@ Customize `tool-bar-mode' if you want to show or hide the tool bar."
325 :initialize 'custom-initialize-default 325 :initialize 'custom-initialize-default
326 :set (lambda (sym val) 326 :set (lambda (sym val)
327 (set-default sym val) 327 (set-default sym val)
328 (modify-all-frames-parameters 328 (modify-all-frames-parameters
329 (list (cons 'tool-bar-position val)))))) 329 (list (cons 'tool-bar-position val))))))
330 330
331 331
332(provide 'tool-bar) 332(provide 'tool-bar)
333;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f 333
334;;; tool-bar.el ends here 334;;; tool-bar.el ends here
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index b63e482ff05..c356dde8226 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -698,7 +698,7 @@ current buffer to the complete file name.
698Optional arg BUFFER-FILE overrides `buffer-file-name'." 698Optional arg BUFFER-FILE overrides `buffer-file-name'."
699 ;; If we are called from a diff, first switch to the source buffer; 699 ;; If we are called from a diff, first switch to the source buffer;
700 ;; in order to respect buffer-local settings of change-log-default-name, etc. 700 ;; in order to respect buffer-local settings of change-log-default-name, etc.
701 (with-current-buffer (let ((buff (if (eq major-mode 'diff-mode) 701 (with-current-buffer (let ((buff (if (derived-mode-p 'diff-mode)
702 (car (ignore-errors 702 (car (ignore-errors
703 (diff-find-source-location)))))) 703 (diff-find-source-location))))))
704 (if (buffer-live-p buff) buff 704 (if (buffer-live-p buff) buff
@@ -1180,7 +1180,7 @@ Has a preference of looking backwards."
1180 ((apply 'derived-mode-p add-log-c-like-modes) 1180 ((apply 'derived-mode-p add-log-c-like-modes)
1181 (or (c-cpp-define-name) 1181 (or (c-cpp-define-name)
1182 (c-defun-name))) 1182 (c-defun-name)))
1183 ((memq major-mode add-log-tex-like-modes) 1183 ((apply #'derived-mode-p add-log-tex-like-modes)
1184 (if (re-search-backward 1184 (if (re-search-backward
1185 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" 1185 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
1186 nil t) 1186 nil t)
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 80d77213abf..c0aa595d968 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -579,6 +579,8 @@ The value should be of the form (REGEXP . REPLACEMENT)
579where REGEXP should match the expression referring to a bug number 579where REGEXP should match the expression referring to a bug number
580in the text, and REPLACEMENT is an expression to pass to `replace-match' 580in the text, and REPLACEMENT is an expression to pass to `replace-match'
581to build the Fixes: header.") 581to build the Fixes: header.")
582(put 'log-edit-rewrite-fixes 'safe-local-variable
583 (lambda (v) (and (stringp (car-safe v)) (stringp (cdr v)))))
582 584
583(defun log-edit-insert-changelog (&optional use-first) 585(defun log-edit-insert-changelog (&optional use-first)
584 "Insert a log message by looking at the ChangeLog. 586 "Insert a log message by looking at the ChangeLog.
diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el
index 3ca9d59e3c1..ba91f7f23c6 100644
--- a/lisp/vc/vc-arch.el
+++ b/lisp/vc/vc-arch.el
@@ -428,7 +428,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
428 (message "There are unresolved conflicts in %s" 428 (message "There are unresolved conflicts in %s"
429 (file-name-nondirectory rej)))))) 429 (file-name-nondirectory rej))))))
430 430
431(defun vc-arch-checkin (files rev comment &optional extra-args-ignored) 431(defun vc-arch-checkin (files rev comment)
432 (if rev (error "Committing to a specific revision is unsupported")) 432 (if rev (error "Committing to a specific revision is unsupported"))
433 ;; FIXME: This implementation probably only works for singleton filesets 433 ;; FIXME: This implementation probably only works for singleton filesets
434 (let ((summary (file-relative-name (car files) (vc-arch-root (car files))))) 434 (let ((summary (file-relative-name (car files) (vc-arch-root (car files)))))
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 03ff1f555a1..a78b59ffba5 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -314,7 +314,7 @@ its parents."
314 (directory-file-name dir)))) 314 (directory-file-name dir))))
315 (eq dir t))) 315 (eq dir t)))
316 316
317(defun vc-cvs-checkin (files rev comment &optional extra-args-ignored) 317(defun vc-cvs-checkin (files rev comment)
318 "CVS-specific version of `vc-backend-checkin'." 318 "CVS-specific version of `vc-backend-checkin'."
319 (unless (or (not rev) (vc-cvs-valid-revision-number-p rev)) 319 (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
320 (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) 320 (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index cb03853f865..3d76d34f3d8 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -175,7 +175,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
175 175
176(declare-function log-edit-extract-headers "log-edit" (headers string)) 176(declare-function log-edit-extract-headers "log-edit" (headers string))
177 177
178(defun vc-mtn-checkin (files rev comment &optional extra-args-ignored) 178(defun vc-mtn-checkin (files rev comment)
179 (apply 'vc-mtn-command nil 0 files 179 (apply 'vc-mtn-command nil 0 files
180 (nconc (list "commit" "-m") 180 (nconc (list "commit" "-m")
181 (log-edit-extract-headers '(("Author" . "--author") 181 (log-edit-extract-headers '(("Author" . "--author")
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 6537c2b96f3..f8d5214d776 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -349,7 +349,7 @@ whether to remove it."
349 (yes-or-no-p (format "Directory %s is empty; remove it? " dir)) 349 (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
350 (delete-directory dir)))) 350 (delete-directory dir))))
351 351
352(defun vc-rcs-checkin (files rev comment &optional extra-args-ignored) 352(defun vc-rcs-checkin (files rev comment)
353 "RCS-specific version of `vc-backend-checkin'." 353 "RCS-specific version of `vc-backend-checkin'."
354 (let ((switches (vc-switches 'RCS 'checkin))) 354 (let ((switches (vc-switches 'RCS 'checkin)))
355 ;; Now operate on the files 355 ;; Now operate on the files
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index fb9cb3fc3f8..2acd778881a 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -237,7 +237,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
237 (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "") 237 (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "")
238 (file-name-nondirectory file))))) 238 (file-name-nondirectory file)))))
239 239
240(defun vc-sccs-checkin (files rev comment &optional extra-args-ignored) 240(defun vc-sccs-checkin (files rev comment)
241 "SCCS-specific version of `vc-backend-checkin'." 241 "SCCS-specific version of `vc-backend-checkin'."
242 (dolist (file (vc-expand-dirs files)) 242 (dolist (file (vc-expand-dirs files))
243 (apply 'vc-sccs-do-command nil 0 "delta" (vc-name file) 243 (apply 'vc-sccs-do-command nil 0 "delta" (vc-name file)
diff --git a/src/ChangeLog b/src/ChangeLog
index 6128808a2a7..3375a46d39e 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -67,6 +67,43 @@
67 * nsterm.m (ns_draw_glyph_string): Handle the case 67 * nsterm.m (ns_draw_glyph_string): Handle the case
68 GLYPHLESS_GLYPH (the detail is not yet implemented). 68 GLYPHLESS_GLYPH (the detail is not yet implemented).
69 69
702010-10-31 Glenn Morris <rgm@gnu.org>
71
72 * xterm.c (x_connection_closed) [USE_X_TOOLKIT]: Fix merge, maybe.
73
74 * frame.c (syms_of_frame) <tool-bar-mode>:
75 Default to nil if !HAVE_WINDOW_SYSTEM. (Bug#7299)
76
772010-10-31 Chong Yidong <cyd@stupidchicken.com>
78
79 * xterm.c (x_connection_closed): Print informative error message
80 when aborting on GTK. This requires using shut_down_emacs
81 directly instead of Fkill_emacs.
82
832010-10-31 Michael Albinus <michael.albinus@gmx.de>
84
85 * dbusbind.c (Fdbus_call_method_asynchronously)
86 (Fdbus_register_signal, Fdbus_register_method): Check, whether
87 `dbus-registered-objects-table' is initialized.
88
892010-10-29 Eli Zaretskii <eliz@gnu.org>
90
91 * emacs.c (main): Call syms_of_filelock unconditionally.
92
93 * filelock.c (syms_of_filelock): Move out of #ifdef CLASH_DETECTION
94 clause, but keep part of it conditioned on CLASH_DETECTION.
95
962010-10-29 Glenn Morris <rgm@gnu.org>
97
98 * nsfns.m (Fx-display-save-under, Fx-open-connection)
99 (Fxw-color-defined-p, Fxw-display-color-p, Fx-show-tip):
100 * w32fns.c (Fxw_color_defined_p, Fx_open_connection):
101 * xfns.c (Fxw_color_defined_p, Fx_open_connection):
102 Sync docs between X, W32, NS.
103
104 * buffer.c (syms_of_buffer) <abbrev-mode, transient-mark-mode>:
105 * frame.c (syms_of_frame) <tool-bar-mode>: Move doc here from Lisp.
106
702010-10-26 Juanma Barranquero <lekktu@gmail.com> 1072010-10-26 Juanma Barranquero <lekktu@gmail.com>
71 108
72 * eval.c (init_eval_once): Set max_lisp_eval_depth to 600; 109 * eval.c (init_eval_once): Set max_lisp_eval_depth to 600;
diff --git a/src/buffer.c b/src/buffer.c
index 5a6bfcba060..67192b4843b 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -5600,7 +5600,8 @@ Format with `format-mode-line' to produce a string value. */);
5600 doc: /* Local (mode-specific) abbrev table of current buffer. */); 5600 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5601 5601
5602 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil, 5602 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
5603 doc: /* Non-nil turns on automatic expansion of abbrevs as they are inserted. */); 5603 doc: /* Non-nil if Abbrev mode is enabled.
5604Use the command `abbrev-mode' to change this variable. */);
5604 5605
5605 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search, 5606 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
5606 Qnil, 5607 Qnil,
@@ -6098,11 +6099,23 @@ to the value obtained by calling `current-time'.
6098If the buffer has never been shown in a window, the value is nil. */); 6099If the buffer has never been shown in a window, the value is nil. */);
6099 6100
6100 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode, 6101 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
6101 doc: /* */); 6102 doc: /* Non-nil if Transient Mark mode is enabled.
6103See the command `transient-mark-mode' for a description of this minor mode.
6104
6105Non-nil also enables highlighting of the region whenever the mark is active.
6106The variable `highlight-nonselected-windows' controls whether to highlight
6107all windows or just the selected window.
6108
6109If the value is `lambda', that enables Transient Mark mode temporarily.
6110After any subsequent action that would normally deactivate the mark
6111\(such as buffer modification), Transient Mark mode is turned off.
6112
6113If the value is (only . OLDVAL), that enables Transient Mark mode
6114temporarily. After any subsequent point motion command that is not
6115shift-translated, or any other action that would normally deactivate
6116the mark (such as buffer modification), the value of
6117`transient-mark-mode' is set to OLDVAL. */);
6102 Vtransient_mark_mode = Qnil; 6118 Vtransient_mark_mode = Qnil;
6103 /* The docstring is in simple.el. If we put it here, it would be
6104 overwritten when transient-mark-mode is defined using
6105 define-minor-mode. */
6106 6119
6107 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only, 6120 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
6108 doc: /* *Non-nil means disregard read-only status of buffers or characters. 6121 doc: /* *Non-nil means disregard read-only status of buffers or characters.
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 683b7cb583b..beb1faaf4aa 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1232,6 +1232,10 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
1232 SDATA (interface), 1232 SDATA (interface),
1233 SDATA (method)); 1233 SDATA (method));
1234 1234
1235 /* Check dbus-registered-objects-table. */
1236 if (!HASH_TABLE_P (Vdbus_registered_objects_table))
1237 XD_SIGNAL1 (build_string ("dbus.el is not loaded"));
1238
1235 /* Open a connection to the bus. */ 1239 /* Open a connection to the bus. */
1236 connection = xd_initialize (bus, TRUE); 1240 connection = xd_initialize (bus, TRUE);
1237 1241
@@ -1869,6 +1873,10 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG
1869 wrong_type_argument (intern ("functionp"), handler); 1873 wrong_type_argument (intern ("functionp"), handler);
1870 GCPRO6 (bus, service, path, interface, signal, handler); 1874 GCPRO6 (bus, service, path, interface, signal, handler);
1871 1875
1876 /* Check dbus-registered-objects-table. */
1877 if (!HASH_TABLE_P (Vdbus_registered_objects_table))
1878 XD_SIGNAL1 (build_string ("dbus.el is not loaded"));
1879
1872 /* Retrieve unique name of service. If service is a known name, we 1880 /* Retrieve unique name of service. If service is a known name, we
1873 will register for the corresponding unique name, if any. Signals 1881 will register for the corresponding unique name, if any. Signals
1874 are sent always with the unique name as sender. Note: the unique 1882 are sent always with the unique name as sender. Note: the unique
@@ -1981,6 +1989,10 @@ used for composing the returning D-Bus message. */)
1981 /* TODO: We must check for a valid service name, otherwise there is 1989 /* TODO: We must check for a valid service name, otherwise there is
1982 a segmentation fault. */ 1990 a segmentation fault. */
1983 1991
1992 /* Check dbus-registered-objects-table. */
1993 if (!HASH_TABLE_P (Vdbus_registered_objects_table))
1994 XD_SIGNAL1 (build_string ("dbus.el is not loaded"));
1995
1984 /* Open a connection to the bus. */ 1996 /* Open a connection to the bus. */
1985 connection = xd_initialize (bus, TRUE); 1997 connection = xd_initialize (bus, TRUE);
1986 1998
diff --git a/src/emacs.c b/src/emacs.c
index e83725ccf03..a38847e3bd3 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1509,9 +1509,7 @@ main (int argc, char **argv)
1509 syms_of_doc (); 1509 syms_of_doc ();
1510 syms_of_editfns (); 1510 syms_of_editfns ();
1511 syms_of_emacs (); 1511 syms_of_emacs ();
1512#ifdef CLASH_DETECTION
1513 syms_of_filelock (); 1512 syms_of_filelock ();
1514#endif /* CLASH_DETECTION */
1515 syms_of_indent (); 1513 syms_of_indent ();
1516 syms_of_insdel (); 1514 syms_of_insdel ();
1517 /* syms_of_keymap (); */ 1515 /* syms_of_keymap (); */
diff --git a/src/filelock.c b/src/filelock.c
index acca7234419..ae0584c447a 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -730,6 +730,8 @@ init_filelock (void)
730 boot_time_initialized = 0; 730 boot_time_initialized = 0;
731} 731}
732 732
733#endif /* CLASH_DETECTION */
734
733void 735void
734syms_of_filelock (void) 736syms_of_filelock (void)
735{ 737{
@@ -737,12 +739,12 @@ syms_of_filelock (void)
737 doc: /* The directory for writing temporary files. */); 739 doc: /* The directory for writing temporary files. */);
738 Vtemporary_file_directory = Qnil; 740 Vtemporary_file_directory = Qnil;
739 741
742#ifdef CLASH_DETECTION
740 defsubr (&Sunlock_buffer); 743 defsubr (&Sunlock_buffer);
741 defsubr (&Slock_buffer); 744 defsubr (&Slock_buffer);
742 defsubr (&Sfile_locked_p); 745 defsubr (&Sfile_locked_p);
746#endif
743} 747}
744 748
745#endif /* CLASH_DETECTION */
746
747/* arch-tag: e062676d-50b2-4be0-ab96-197c81b181a1 749/* arch-tag: e062676d-50b2-4be0-ab96-197c81b181a1
748 (do not change this comment) */ 750 (do not change this comment) */
diff --git a/src/frame.c b/src/frame.c
index 1c9d471cfa9..ba675be5b5f 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -4571,8 +4571,16 @@ or call the function `menu-bar-mode'. */);
4571 Vmenu_bar_mode = Qt; 4571 Vmenu_bar_mode = Qt;
4572 4572
4573 DEFVAR_LISP ("tool-bar-mode", &Vtool_bar_mode, 4573 DEFVAR_LISP ("tool-bar-mode", &Vtool_bar_mode,
4574 doc: /* Non-nil if Tool-Bar mode is enabled. */); 4574 doc: /* Non-nil if Tool-Bar mode is enabled.
4575See the command `tool-bar-mode' for a description of this minor mode.
4576Setting this variable directly does not take effect;
4577either customize it (see the info node `Easy Customization')
4578or call the function `tool-bar-mode'. */);
4579#ifdef HAVE_WINDOW_SYSTEM
4575 Vtool_bar_mode = Qt; 4580 Vtool_bar_mode = Qt;
4581#else
4582 Vtool_bar_mode = Qnil;
4583#endif
4576 4584
4577 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame, 4585 DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
4578 doc: /* Minibufferless frames use this frame's minibuffer. 4586 doc: /* Minibufferless frames use this frame's minibuffer.
diff --git a/src/nsfns.m b/src/nsfns.m
index db8bbeb5f76..147f9aab801 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -1,6 +1,7 @@
1/* Functions for the NeXT/Open/GNUstep and MacOSX window system. 1/* Functions for the NeXT/Open/GNUstep and MacOSX window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009, 2010 2
3 Free Software Foundation, Inc. 3Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009, 2010
4 Free Software Foundation, Inc.
4 5
5This file is part of GNU Emacs. 6This file is part of GNU Emacs.
6 7
@@ -1697,7 +1698,7 @@ If omitted or nil, the selected frame's display is used. */)
1697 1698
1698DEFUN ("x-display-save-under", Fx_display_save_under, 1699DEFUN ("x-display-save-under", Fx_display_save_under,
1699 Sx_display_save_under, 0, 1, 0, 1700 Sx_display_save_under, 0, 1, 0,
1700 doc: /* Non-nil if the Nextstep display server supports the save-under feature. 1701 doc: /* Return t if DISPLAY supports the save-under feature.
1701The optional argument DISPLAY specifies which display to ask about. 1702The optional argument DISPLAY specifies which display to ask about.
1702DISPLAY should be a frame, the display name as a string, or a terminal ID. 1703DISPLAY should be a frame, the display name as a string, or a terminal ID.
1703If omitted or nil, the selected frame's display is used. */) 1704If omitted or nil, the selected frame's display is used. */)
@@ -1722,9 +1723,12 @@ If omitted or nil, the selected frame's display is used. */)
1722 1723
1723DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1724DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1724 1, 3, 0, 1725 1, 3, 0,
1725 doc: /* Open a connection to a Nextstep display server. 1726 doc: /* Open a connection to a display server.
1726DISPLAY is the name of the display to connect to. 1727DISPLAY is the name of the display to connect to.
1727Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored. */) 1728Optional second arg XRM-STRING is a string of resources in xrdb format.
1729If the optional third arg MUST-SUCCEED is non-nil,
1730terminate Emacs if we can't open the connection.
1731\(In the Nextstep version, the last two arguments are currently ignored.) */)
1728 (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) 1732 (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1729{ 1733{
1730 struct ns_display_info *dpyinfo; 1734 struct ns_display_info *dpyinfo;
@@ -2201,8 +2205,8 @@ x_sync (struct frame *f)
2201 2205
2202 2206
2203DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, 2207DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2204 doc: /* Return t if the current Nextstep display supports the color COLOR. 2208 doc: /* Internal function called by `color-defined-p', which see.
2205The optional argument FRAME is currently ignored. */) 2209\(Note that the Nextstep version of this function ignores FRAME.) */)
2206 (Lisp_Object color, Lisp_Object frame) 2210 (Lisp_Object color, Lisp_Object frame)
2207{ 2211{
2208 NSColor * col; 2212 NSColor * col;
@@ -2233,10 +2237,7 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2233 2237
2234 2238
2235DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, 2239DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2236 doc: /* Return t if the Nextstep display supports color. 2240 doc: /* Internal function called by `display-color-p', which see. */)
2237The optional argument DISPLAY specifies which display to ask about.
2238DISPLAY should be either a frame, a display name (a string), or terminal ID.
2239If omitted or nil, that stands for the selected frame's display. */)
2240 (Lisp_Object display) 2241 (Lisp_Object display)
2241{ 2242{
2242 NSWindowDepth depth; 2243 NSWindowDepth depth;
@@ -2430,6 +2431,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2430 doc: /* Show STRING in a \"tooltip\" window on frame FRAME. 2431 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2431A tooltip window is a small window displaying a string. 2432A tooltip window is a small window displaying a string.
2432 2433
2434This is an internal function; Lisp code should call `tooltip-show'.
2435
2433FRAME nil or omitted means use the selected frame. 2436FRAME nil or omitted means use the selected frame.
2434 2437
2435PARMS is an optional list of frame parameters which can be used to 2438PARMS is an optional list of frame parameters which can be used to
@@ -2675,4 +2678,3 @@ be used as the image of the icon representing the frame. */);
2675 2678
2676} 2679}
2677 2680
2678// arch-tag: dc2a3f74-1123-4daa-8eed-fb78db6a5642
diff --git a/src/w32fns.c b/src/w32fns.c
index 1612182c660..15dbb404737 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -4511,7 +4511,8 @@ DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4511 4511
4512 4512
4513DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, 4513DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4514 doc: /* Internal function called by `color-defined-p', which see. */) 4514 doc: /* Internal function called by `color-defined-p', which see.
4515\(Note that the Nextstep version of this function ignores FRAME.) */)
4515 (Lisp_Object color, Lisp_Object frame) 4516 (Lisp_Object color, Lisp_Object frame)
4516{ 4517{
4517 XColor foo; 4518 XColor foo;
@@ -4851,11 +4852,12 @@ x_display_info_for_name (Lisp_Object name)
4851} 4852}
4852 4853
4853DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 4854DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4854 1, 3, 0, doc: /* Open a connection to a server. 4855 1, 3, 0, doc: /* Open a connection to a display server.
4855DISPLAY is the name of the display to connect to. 4856DISPLAY is the name of the display to connect to.
4856Optional second arg XRM-STRING is a string of resources in xrdb format. 4857Optional second arg XRM-STRING is a string of resources in xrdb format.
4857If the optional third arg MUST-SUCCEED is non-nil, 4858If the optional third arg MUST-SUCCEED is non-nil,
4858terminate Emacs if we can't open the connection. */) 4859terminate Emacs if we can't open the connection.
4860\(In the Nextstep version, the last two arguments are currently ignored.) */)
4859 (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed) 4861 (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed)
4860{ 4862{
4861 unsigned char *xrm_option; 4863 unsigned char *xrm_option;
@@ -7267,5 +7269,3 @@ w32_last_error (void)
7267 return GetLastError (); 7269 return GetLastError ();
7268} 7270}
7269 7271
7270/* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
7271 (do not change this comment) */
diff --git a/src/xfns.c b/src/xfns.c
index 9958e6607e5..6492bbd8a23 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -3581,7 +3581,8 @@ FRAME nil means use the selected frame. */)
3581 3581
3582 3582
3583DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, 3583DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3584 doc: /* Internal function called by `color-defined-p', which see. */) 3584 doc: /* Internal function called by `color-defined-p', which see
3585.\(Note that the Nextstep version of this function ignores FRAME.) */)
3585 (Lisp_Object color, Lisp_Object frame) 3586 (Lisp_Object color, Lisp_Object frame)
3586{ 3587{
3587 XColor foo; 3588 XColor foo;
@@ -4099,11 +4100,12 @@ x_display_info_for_name (Lisp_Object name)
4099 4100
4100DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 4101DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4101 1, 3, 0, 4102 1, 3, 0,
4102 doc: /* Open a connection to an X server. 4103 doc: /* Open a connection to a display server.
4103DISPLAY is the name of the display to connect to. 4104DISPLAY is the name of the display to connect to.
4104Optional second arg XRM-STRING is a string of resources in xrdb format. 4105Optional second arg XRM-STRING is a string of resources in xrdb format.
4105If the optional third arg MUST-SUCCEED is non-nil, 4106If the optional third arg MUST-SUCCEED is non-nil,
4106terminate Emacs if we can't open the connection. */) 4107terminate Emacs if we can't open the connection.
4108\(In the Nextstep version, the last two arguments are currently ignored.) */)
4107 (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed) 4109 (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed)
4108{ 4110{
4109 unsigned char *xrm_option; 4111 unsigned char *xrm_option;
diff --git a/src/xterm.c b/src/xterm.c
index 83e9465daf3..463ea8b7dc2 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -7755,47 +7755,43 @@ x_connection_closed (Display *dpy, const char *error_message)
7755 delete_frame (frame, Qnoelisp); 7755 delete_frame (frame, Qnoelisp);
7756 } 7756 }
7757 7757
7758 /* We have to close the display to inform Xt that it doesn't 7758 /* If DPYINFO is null, this means we didn't open the display in the
7759 exist anymore. If we don't, Xt will continue to wait for 7759 first place, so don't try to close it. */
7760 events from the display. As a consequence, a sequence of
7761
7762 M-x make-frame-on-display RET :1 RET
7763 ...kill the new frame, so that we get an IO error...
7764 M-x make-frame-on-display RET :1 RET
7765
7766 will indefinitely wait in Xt for events for display `:1', opened
7767 in the first call to make-frame-on-display.
7768
7769 Closing the display is reported to lead to a bus error on
7770 OpenWindows in certain situations. I suspect that is a bug
7771 in OpenWindows. I don't know how to circumvent it here. */
7772
7773 if (dpyinfo) 7760 if (dpyinfo)
7774 { 7761 {
7775#ifdef USE_X_TOOLKIT 7762#ifdef USE_X_TOOLKIT
7776 /* If DPYINFO is null, this means we didn't open the display 7763 /* We have to close the display to inform Xt that it doesn't
7777 in the first place, so don't try to close it. */ 7764 exist anymore. If we don't, Xt will continue to wait for
7778 { 7765 events from the display. As a consequence, a sequence of
7779 fatal_error_signal_hook = x_fatal_error_signal; 7766
7780 XtCloseDisplay (dpy); 7767 M-x make-frame-on-display RET :1 RET
7781 fatal_error_signal_hook = NULL; 7768 ...kill the new frame, so that we get an IO error...
7782 } 7769 M-x make-frame-on-display RET :1 RET
7783#endif 7770
7771 will indefinitely wait in Xt for events for display `:1',
7772 opened in the first call to make-frame-on-display.
7773
7774 Closing the display is reported to lead to a bus error on
7775 OpenWindows in certain situations. I suspect that is a bug
7776 in OpenWindows. I don't know how to circumvent it here. */
7777 fatal_error_signal_hook = x_fatal_error_signal;
7778 XtCloseDisplay (dpy);
7779 fatal_error_signal_hook = NULL;
7780#endif /* USE_X_TOOLKIT */
7784 7781
7785#ifdef USE_GTK 7782#ifdef USE_GTK
7786 /* There is a long-standing bug in GTK that prevents the GTK 7783 /* A long-standing GTK bug prevents proper disconnect handling
7787 main loop from recovering gracefully from disconnects 7784 (https://bugzilla.gnome.org/show_bug.cgi?id=85715). Once,
7788 (https://bugzilla.gnome.org/show_bug.cgi?id=85715). Among 7785 the resulting Glib error message loop filled a user's disk.
7789 other problems, this gives rise to a stream of Glib error 7786 To avoid this, kill Emacs unconditionally on disconnect. */
7790 messages that, in one incident, filled up a user's hard disk 7787 shut_down_emacs (0, 0, Qnil);
7791 (http://lists.gnu.org/archive/html/emacs-devel/2010-10/msg00927.html). 7788 fprintf (stderr, "%s\n\
7792 So, kill Emacs unconditionally if the display is closed. */ 7789When compiled with GTK, Emacs cannot recover from X disconnects.\n\
7793 { 7790This is a GTK bug: https://bugzilla.gnome.org/show_bug.cgi?id=85715\n\
7794 fprintf (stderr, "%s\n", error_msg); 7791For details, see etc/PROBLEMS.\n",
7795 Fkill_emacs (make_number (70)); 7792 error_msg);
7796 abort (); /* NOTREACHED */ 7793 abort ();
7797 } 7794#endif /* USE_GTK */
7798#endif
7799 7795
7800 /* Indicate that this display is dead. */ 7796 /* Indicate that this display is dead. */
7801 dpyinfo->display = 0; 7797 dpyinfo->display = 0;