diff options
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 @@ +2010-10-31 Ken Brown <kbrown@cornell.edu> + + * configure.in (checking whether localtime caches TZ): Use + unsetenv instead of modifying environment directly. + 2010-10-25 Andreas Schwab <schwab@linux-m68k.org> * 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 *** To remove a "fixed" mark: notfixed 123 23.0.60 +*** To make a bug as present in a particular version: +found 123 23.2 +NB if there is no specified "fixed" version, or if there is one and it +is earlier than the found version, this reopens a closed bug. + +The leading "23.1;" that M-x report-emacs-bug adds to bug subjects +automatically sets a found version (if none is explicitly specified). + *** To assign or reassign a bug to a package or list of packages: reassign 1234 emacs diff --git a/configure b/configure index c12401e2d16..3e3f91d4537 100755 --- a/configure +++ b/configure @@ -13982,14 +13982,6 @@ else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <time.h> -extern char **environ; -unset_TZ () -{ - char **from, **to; - for (to = from = environ; (*to = *from); from++) - if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '=')) - to++; -} char TZ_GMT0[] = "TZ=GMT0"; char TZ_PST8[] = "TZ=PST8"; main() @@ -13999,13 +13991,13 @@ main() if (putenv (TZ_GMT0) != 0) exit (1); hour_GMT0 = localtime (&now)->tm_hour; - unset_TZ (); + unsetenv("TZ"); hour_unset = localtime (&now)->tm_hour; if (putenv (TZ_PST8) != 0) exit (1); if (localtime (&now)->tm_hour == hour_GMT0) exit (1); - unset_TZ (); + unsetenv("TZ"); if (localtime (&now)->tm_hour != hour_unset) exit (1); 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) AC_CACHE_VAL(emacs_cv_localtime_cache, [if test x$ac_cv_func_tzset = xyes; then AC_TRY_RUN([#include <time.h> -extern char **environ; -unset_TZ () -{ - char **from, **to; - for (to = from = environ; (*to = *from); from++) - if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '=')) - to++; -} char TZ_GMT0[] = "TZ=GMT0"; char TZ_PST8[] = "TZ=PST8"; main() @@ -2969,13 +2961,13 @@ main() if (putenv (TZ_GMT0) != 0) exit (1); hour_GMT0 = localtime (&now)->tm_hour; - unset_TZ (); + unsetenv("TZ"); hour_unset = localtime (&now)->tm_hour; if (putenv (TZ_PST8) != 0) exit (1); if (localtime (&now)->tm_hour == hour_GMT0) exit (1); - unset_TZ (); + unsetenv("TZ"); if (localtime (&now)->tm_hour != hour_unset) exit (1); 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 @@ +2010-10-31 Glenn Morris <rgm@gnu.org> + + * maps.texi (Standard Keymaps): Update File menu description. + 2010-10-28 Glenn Morris <rgm@gnu.org> * 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 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. @c Copyright (C) 1990, 1991, 1992, 1993, 1999, 2001, 2002, 2003, 2004, -@c 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +@c 2005, 2006, 2007, 2008, 2009, 2010 +@c Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @setfilename ../../info/maps @node Standard Keymaps, Standard Hooks, Standard Buffer-Local Variables, Top @@ -183,9 +184,9 @@ A sparse keymap used by Lisp mode. @vindex menu-bar-edit-menu The keymap which displays the Edit menu in the menu bar. -@item menu-bar-files-menu -@vindex menu-bar-files-menu -The keymap which displays the Files menu in the menu bar. +@item menu-bar-file-menu +@vindex menu-bar-file-menu +The keymap which displays the File menu in the menu bar. @item menu-bar-help-menu @vindex menu-bar-help-menu @@ -239,6 +240,3 @@ The keymap defining the contents of the tool bar. A full keymap used by View mode. @end table -@ignore - arch-tag: b741253c-7e23-4a02-b3fa-cffd9e4d72b9 -@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 @@ +2010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Paging the Article): Document C-u g/C-u C-u g. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * mh-e.texi (Preface, From Bill Wohler): Change 23 to past tense. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * cc-mode.texi: Remove reference to defunct viewcvs URL. + +2010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Client-Side IMAP Splitting): Mention + nnimap-unsplittable-articles. + +2010-10-29 Julien Danjou <julien@danjou.info> + + * gnus.texi (Finding the News): Remove references to obsoletes + variables `gnus-nntp-server' and `gnus-secondary-servers'. + +2010-10-29 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in (MAKEINFO): Add -I$(emacsdir). + (ENVADD): Remove extra -I$(emacsdir), included in $(MAKEINFO). + ($(infodir)/efaq): Remove -I$(emacsdir), included in $(MAKEINFO). + ($(infodir)/calc, calc.dvi): Depend on $(emacsdir)/emacsver.texi. + 2010-10-28 Glenn Morris <rgm@gnu.org> * Makefile.in (MAKEINFO, ENVADD): Add $emacsdir to include path. @@ -12,7 +41,7 @@ 2010-10-24 Jay Belanger <jay.p.belanger@gmail.com> - * calc.texi: Use emacsver.texi to determine Emacs version. + * calc.texi: Use emacsver.texi to determine Emacs version. 2010-10-24 Juanma Barranquero <lekktu@gmail.com> 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 This manual is for CC Mode in Emacs. Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -201,9 +202,8 @@ developing GNU and promoting software freedom.'' @vskip 0pt plus 1filll @insertcopying -This manual was generated from cc-mode.texi, which can be downloaded -from -@url{http://cvs.savannah.gnu.org/viewcvs/emacs/emacs/doc/misc/cc-mode.texi}. +This manual was generated from cc-mode.texi, which is distributed with Emacs, +or can be downloaded from @url{http://savannah.gnu.org/projects/emacs/}. @end titlepage @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -7015,6 +7015,3 @@ Since most @ccmode{} variables are prepended with the string @bye -@ignore - arch-tag: c4cab162-5e57-4366-bdce-4a9db2fc97f0 -@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} If that fails as well, Gnus will try to use the machine running Emacs as an @acronym{NNTP} server. That's a long shot, though. -@vindex gnus-nntp-server -If @code{gnus-nntp-server} is set, this variable will override -@code{gnus-select-method}. You should therefore set -@code{gnus-nntp-server} to @code{nil}, which is what it is by default. - -@vindex gnus-secondary-servers -@vindex gnus-nntp-server -You can also make Gnus prompt you interactively for the name of an -@acronym{NNTP} server. If you give a non-numerical prefix to @code{gnus} -(i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers -in the @code{gnus-secondary-servers} list (if any). You can also just -type in the name of any server you feel like visiting. (Note that this -will set @code{gnus-nntp-server}, which means that if you then @kbd{M-x -gnus} later in the same Emacs session, Gnus will contact the same -server.) - @findex gnus-group-browse-foreign-server @kindex B (Group) However, if you use one @acronym{NNTP} server regularly and are just @@ -5204,24 +5188,6 @@ used for fetching the file. If fetching from the first site is unsuccessful, Gnus will attempt to go through @code{gnus-group-faq-directory} and try to open them one by one. -@item H C -@kindex H C (Group) -@findex gnus-group-fetch-control -@vindex gnus-group-fetch-control-use-browse-url -@cindex control message -Fetch the control messages for the group from the archive at -@code{ftp.isc.org} (@code{gnus-group-fetch-control}). Query for a -group if given a prefix argument. - -If @code{gnus-group-fetch-control-use-browse-url} is non-@code{nil}, -Gnus will open the control messages in a browser using -@code{browse-url}. Otherwise they are fetched using @code{ange-ftp} -and displayed in an ephemeral group. - -Note that the control messages are compressed. To use this command -you need to turn on @code{auto-compression-mode} (@pxref{Compressed -Files, ,Compressed Files, emacs, The Emacs Manual}). - @item H d @itemx C-c C-d @c @icon{gnus-group-describe-group} @@ -6187,8 +6153,9 @@ Scroll the current article one line backward @vindex gnus-summary-show-article-charset-alist (Re)fetch the current article (@code{gnus-summary-show-article}). If given a prefix, fetch the current article, but don't run any of the -article treatment functions. This will give you a ``raw'' article, just -the way it came from the server. +article treatment functions. If given a prefix twice (i.e., @kbd{C-u +C-u g'}), show a completely ``raw'' article, just the way it came from +the server. @cindex charset, view article with different charset If 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 name will be removed. If the attribute name is @code{eval}, the form is evaluated, and the result is thrown away. -The attribute value can be a string (used verbatim), a function with -zero arguments (the return value will be used), a variable (its value -will be used) or a list (it will be @code{eval}ed and the return value -will be used). The functions and sexps are called/@code{eval}ed in the -message buffer that is being set up. The headers of the current article -are available through the @code{message-reply-headers} variable, which -is a vector of the following headers: number subject from date id -references chars lines xref extra. +The attribute value can be a string, a function with zero arguments +(the return value will be used), a variable (its value will be used) +or a list (it will be @code{eval}ed and the return value will be +used). The functions and sexps are called/@code{eval}ed in the +message buffer that is being set up. The headers of the current +article are available through the @code{message-reply-headers} +variable, which is a vector of the following headers: number subject +from date id references chars lines xref extra. + +In the case of a string value, if the @code{match} is a regular +expression, a @samp{gnus-match-substitute-replacement} is proceed on +the value to replace the positional parameters @samp{\@var{n}} by the +corresponding parenthetical matches (see @xref{Replacing the Text that +Matched, , Text Replacement, elisp, The Emacs Lisp Reference Manual}.) @vindex message-reply-headers @@ -14945,6 +14918,11 @@ use the value of the @code{nnmail-split-methods} variable. @item nnimap-split-fancy Uses the same syntax as @code{nnmail-split-fancy}. +@item nnimap-unsplittable-articles +List of flag symbols to ignore when doing splitting. That is, +articles that have these flags won't be considered when splitting. +The default is @samp{(%Deleted %Seen)}. + @end table @@ -30102,11 +30080,11 @@ that means: (setq gnus-read-active-file 'some) @end lisp -On the other hand, if the manual says ``set @code{gnus-nntp-server} to -@samp{nntp.ifi.uio.no}'', that means: +On the other hand, if the manual says ``set @code{gnus-nntp-server-file} to +@samp{/etc/nntpserver}'', that means: @lisp -(setq gnus-nntp-server "nntp.ifi.uio.no") +(setq gnus-nntp-server-file "/etc/nntpserver") @end lisp So 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 emacsdir = $(srcdir)/../emacs # The makeinfo program is part of the Texinfo distribution. -MAKEINFO = makeinfo --force +MAKEINFO = makeinfo --force -I$(emacsdir) MULTI_INSTALL_INFO = $(srcdir)\..\..\nt\multi-install-info.bat INFO_TARGETS = $(infodir)/ccmode \ $(infodir)/cl $(infodir)/dbus $(infodir)/dired-x \ @@ -70,7 +70,7 @@ INFOSOURCES = info.texi TEXI2DVI = texi2dvi ENVADD = $(srcdir)\..\..\nt\envadd.bat "TEXINPUTS=$(srcdir);$(TEXINPUTS)" \ - "MAKEINFO=$(MAKEINFO) -I$(srcdir) -I$(emacsdir)" /C + "MAKEINFO=$(MAKEINFO) -I$(srcdir)" /C info: $(INFO_TARGETS) @@ -218,7 +218,7 @@ widget.dvi: widget.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/widget.texi $(infodir)/efaq: faq.texi $(emacsdir)/emacsver.texi - $(MAKEINFO) -I$(emacsdir) faq.texi + $(MAKEINFO) faq.texi faq.dvi: faq.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/faq.texi @@ -227,10 +227,10 @@ $(infodir)/autotype: autotype.texi autotype.dvi: autotype.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/autotype.texi -$(infodir)/calc: calc.texi +$(infodir)/calc: calc.texi $(emacsdir)/emacsver.texi $(MAKEINFO) calc.texi -calc.dvi: calc.texi +calc.dvi: calc.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/calc.texi # 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 them. The MH-E package is distributed with GNU Emacs@footnote{Version -@value{VERSION} of MH-E will appear in GNU Emacs 23.1. It is supported +@value{VERSION} of MH-E appeared in GNU Emacs 23.1. It is supported in GNU Emacs 21 and 22, as well as XEmacs 21 (except for versions 21.5.9-21.5.16). It is compatible with MH versions 6.8.4 and higher, all 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 reorganized to push back two decades of entropy. Version 8 appeared in Emacs 22.1 in 2006. -Development was then quiet for a couple of years. Emacs 23.1, which is -due out in 2009, will contain version 8.1. This version includes a few +Development was then quiet for a couple of years. Emacs 23.1, released +in June 2009, contains version 8.2. This version includes a few new features and several bug fixes. Bill Wohler, August 2008 @@ -9061,6 +9061,4 @@ Bill Wohler, August 2008 @c sentence-end-double-space: nil @c End: -@ignore - arch-tag: b778477d-1a10-4a99-84de-f877a2ea6bef -@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 @@ * COPYRIGHT -Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. +Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, + 2010 Free Software Foundation, Inc. See the end of the file for license conditions. * Changes in MH-E 8.2 -Version 8.2 of MH-E will appear in GNU Emacs 23.1. This is a small +Version 8.2 of MH-E appeared in GNU Emacs 23.1. This is a small release that includes internal changes from the Emacs team. A new hook, `mh-pack-folder-hook', has been added. @@ -231,7 +231,7 @@ gatewayed at gmane.org (closes SF #979308). If you want to see the release notes for the alpha and beta releases leading up this release, please see: - http://cvs.savannah.gnu.org/viewcvs/emacs/etc/MH-E-NEWS?rev=1.25&root=emacs&view=markup + http://cvs.savannah.gnu.org/viewvc/emacs/emacs/etc/MH-E-NEWS?revision=1.25&view=markup @@ -187,7 +187,7 @@ for `list-colors-display'. ** An Emacs Lisp package manager is now included. This is a convenient way to download and install additional packages, -from elpa.gnu.org. +from a package repository at elpa.gnu.org. *** `M-x list-packages' shows a list of packages, which can be selected for installation. @@ -227,8 +227,8 @@ and no prefix argument is given. If set to `kill', these commands kill instead. *** New command `delete-forward-char', bound to C-d and [delete]. -This is meant for interactive use, and obeys `delete-active-region'; -delete-char, meant for Lisp, does not obey `delete-active-region'. +This is meant for interactive use, and obeys `delete-active-region'. +The command `delete-char' does not obey `delete-active-region'. *** `delete-backward-char' is now a Lisp function. Apart from obeying `delete-active-region', its behavior is unchanged. @@ -240,65 +240,53 @@ should use delete-char with a negative argument instead. ** Selection changes. The default handling of clipboard and primary selections has been -changed to conform with other X applications. - -The new behavior is that by default Emacs does not put selected text -into the clipboard, and does not add it to kill-ring, merely because -the text was selected. Only commands that kill text or copy it to the -kill-ring (C-w, M-w, C-k, etc.) put the killed text into the -clipboard. Selected text is put into the primary selection (on -systems, such as X, that support the primary selection separately from -the clipboard). - -Similarly, Emacs by default does not retrieve text from the clipboard -when the mouse (e.g., mouse-2) is used for pasting text selected in -another application. Mouse commands that paste text retrieve text -from the primary selection, on systems that support it separately from -the clipboard. Text from the clipboard is retrieved only by C-y, M-y -and other commands that yank text from the kill-ring. - -In other words, the default behavior is that mouse gestures that -select and paste text work with the primary selection (on X), while -keyboard commands that kill/copy and paste text work with the -clipboard. - -This change also means that the "Copy", "Cut", and "Paste" items of -the menu-bar "Edit" menu are now exactly equivalent to, respectively -M-w, C-w, and C-y. - -To get back the previous behavior, whereby mouse gestures set the -clipboard and retrieve text from there, customize the variables -`mouse-drag-copy-region' and (on X only) `x-select-enable-primary' to -non-nil values. If you don't want Emacs to put the text into the -clipboard, only to the primary selection, additionally customize -`x-select-enable-clipboard' to nil. - -These changes in the default behavior are reflected in the default -values of several variables: - -*** `select-active-regions' now defaults to t, so active regions set -the primary selection. It was nil in previous versions. +changed to conform with other X applications. The exact changes are +described below; in short, mouse commands to select and paste text now +use the primary selection, while all other commands for killing and +yanking text now use the clipboard. +*** Merely selecting text (e.g. with drag-mouse-1) does not add it to +the kill-ring. On systems with a primary selection separate from the +clipboard (such as X), the selected text is put in the primary +selection. + +*** mouse-2 is now bound to `mouse-yank-primary', which pastes from +the primary selection regardless of the contents of the kill-ring. + +*** Commands that kill text or copy it to the kill-ring (M-w, C-w, +C-k, etc.) also put the killed text into the clipboard. This change +also means that the "Copy", "Cut", and "Paste" items in the "Edit" +menu are now exactly equivalent to, respectively M-w, C-w, and C-y. + +*** Yank commands, such as C-y and M-y, retrieve text from the +clipboard if it is available. + +*** The above changes are reflected in the following new defaults: + +**** `select-active-regions' now defaults to t. It also accepts a new value, `only', which means to only set the primary selection for temporarily active regions (usually made by mouse-dragging or shift-selection). -*** `mouse-2' is now bound to `mouse-yank-primary'. +**** `mouse-2' is now bound to `mouse-yank-primary'. Previously, it was bound to `mouse-yank-at-click' (which is now unbound by default). -*** `x-select-enable-clipboard' now defaults to t on all platforms. -Thus, killing and yanking now use the clipboard (in addition to the -kill ring). Note that this variable was already non-nil by default on -MS-Windows, which does not support the primary selection between -applications. +**** `x-select-enable-clipboard' now defaults to t on all platforms. +Note that this variable was already non-nil by default on MS-Windows, +which does not support the primary selection between applications. -*** `x-select-enable-primary' now defaults to nil. +**** `x-select-enable-primary' now defaults to nil. This variable exists only on X; its default value was t in previous versions. -*** `mouse-drag-copy-region' now defaults to nil. -Its previous default value was t. +**** `mouse-drag-copy-region' now defaults to nil. + +*** To return to the previous behavior, where mouse commands use the +clipboard, change `mouse-drag-copy-region' and (on X only) +`x-select-enable-primary' to t. If you don't want Emacs to put the +text into the clipboard, only to the primary selection, additionally +set `x-select-enable-clipboard' to nil. *** Support for X cut buffers has been removed. @@ -350,7 +338,7 @@ view-diary-entries, list-diary-entries, show-all-diary-entries *** Customize buffers now contain a search field. The search is performed using `customize-apropos'. -To turn off the search field, set custom-search-field to nil . +To turn off the search field, set custom-search-field to nil. *** Custom options now start out hidden if at their default values. Use the arrow to the left of the option name to toggle visibility. @@ -365,41 +353,6 @@ choose a color via list-colors-display. *** dired-jump and dired-jump-other-window called with a prefix argument read a file name from the minibuffer instead of using buffer-file-name. -** VC and related modes - -*** New VC commands: vc-log-incoming, vc-log-outgoing, vc-find-conflicted-file. - -**** vc-log-incoming for Git runs "git fetch" so that the necessary -data is available locally. - -**** vc-log-incoming and vc-log-outgoing for Git require version 1.7 (or newer). - -*** New key bindings: C-x v I and C-x v O bound to vc-log-incoming and -vc-log-outgoing, respectively. - -*** The 'g' key in VC diff, log, log-incoming and log-outgoing buffers -reruns the corresponding VC command to compute an up to date version -of the buffer. - -*** vc-dir for Bzr supports viewing shelve contents and shelving snapshots. - -*** Special markup can be added to log-edit buffers. -The log-edit buffers are expected to have a format similar to email messages -with headers of the form: - Author: <author of this change> - Summary: <one line summary of this change> - Fixes: <reference to the bug fixed by this change> -Some backends handle some of those headers specially, but any unknown header -is just left as is in the message, so it is not lost. - -**** vc-git handles Author: and Date: -**** vc-hg handles Author: and Date: -**** vc-bzr handles Author:, Date: and Fixes: -**** vc-mtn handles Author: and Date: - -*** Pressing g in a *vc-diff* buffer reruns vc-diff, so it will -produce an up to date diff. - ** Directory local variables can apply to file-less buffers. For example, adding "(diff-mode . ((mode . whitespace)))" to your .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. * Incompatible Lisp Changes in Emacs 24.1 +** Remove obsolete name `e' (use `float-e' instead). + ** A backquote not followed by a space is now always treated as new-style. ** Test for special mode-class was moved from view-file to view-buffer. @@ -630,6 +585,8 @@ font-lock-defaults-alist ** The following files, obsolete since at least Emacs 21.1, have been removed: sc.el, x-menu.el, rnews.el, rnewspost.el +** FIXME finder-inf.el changes. + * Lisp changes in Emacs 24.1 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5d2e442a1c1..9be6d045de3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -12,6 +12,185 @@ * faces.el (glyphless-char): New face. +2010-11-01 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/smie.el (smie): New custom group. + (smie-blink-matching-inners, smie-indent-basic): Add :group. + + * faces.el (xw-defined-colors, x-setup-function-keys): + * mouse-sel.el (x-select-text): + * term/w32console.el (x-setup-function-keys): Update declarations. + + * progmodes/ruby-mode.el (ruby-syntax-propertize-heredoc): Declare. + + * textmodes/ispell.el (comment-add): Declare. + + * net/gnutls.el (gnutls-boot, gnutls-errorp, gnutls-error-string): + Declare. + + * info.el (finder-keywords-hash, package-alist): Declare. + +2010-11-01 Chong Yidong <cyd@stupidchicken.com> + + * finder.el (finder-compile-keywords): Don't use intern-soft, + since package names may not yet exist in the obarray. + +2010-11-01 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc-arch.el (vc-arch-checkin): + * vc/vc-cvs.el (vc-cvs-checkin): + * vc/vc-mtn.el (vc-mtn-checkin): + * vc/vc-rcs.el (vc-rcs-checkin): + * vc/vc-sccs.el (vc-sccs-checkin): + * vc/vc-svn.el (vc-svn-checkin): Remove optional extra arg, unused + since 2010-04-21 commit by Stefan Monnier. + +2010-11-01 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-recompile-file): Fix previous change. + + * startup.el (package-enable-at-startup, package-initialize): + Silence compiler. + + * progmodes/ada-mode.el (ada-font-lock-syntactic-keywords): + Silence compiler. + +2010-10-31 Julien Danjou <julien@danjou.info> + + * emacs-lisp/bytecomp.el (byte-recompile-file): New fun (bug#7297). + (byte-recompile-directory): + * emacs-lisp/lisp-mode.el (emacs-lisp-byte-compile-and-load): + Use `byte-recompile-file'. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * cus-start.el: Handle standard values via a keyword. + Only set version property if specified. + (cursor-in-non-selected-windows, menu-bar-mode) + (tool-bar-mode, show-trailing-whitespace): + Do not specify standard values. + (transient-mark-mode, temporary-file-directory): Use :standard. + +2010-10-31 Jan Djärv <jan.h.d@swipnet.se> + + * term/x-win.el (x-get-selection-value): New function that gets + PRIMARY with type as specified in x-select-request-type. (Bug#6802). + +2010-10-31 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-insert-file-contents): For root, + preserve owner and group when editing files. (Bug#7289) + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * speedbar.el (speedbar-mode): + * play/fortune.el (fortune-in-buffer, fortune): + * play/gomoku.el (gomoku-mode): + * play/landmark.el (lm-mode): + * textmodes/bibtex.el (bibtex-validate, bibtex-validate-globally): + Replace inappropriate uses of toggle-read-only. (Bug#7292) + + * select.el (x-selection): Mark it as an obsolete alias. + +2010-10-31 Aaron S. Hawley <aaron.s.hawley@gmail.com> + + * vc/add-log.el (find-change-log): Use derived-mode-p rather than + major-mode (bug#7284). + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * menu-bar.el (menu-bar-files-menu): Make it into an actual alias, + rather than just an unused variable that inherits from the real one. + +2010-10-31 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-cmds.el (c-mask-paragraph): Fix an off-by-1 error. + This fixes bug #7185. + +2010-10-30 Chong Yidong <cyd@stupidchicken.com> + + * startup.el (command-line): Search for package directories, and + don't load package.el if none are found. + + * emacs-lisp/package.el (describe-package, list-packages): Call + package-initialize if it has not been called yet. + +2010-10-30 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-fonts.el (c-font-lock-enum-tail): New function + which fontifies the tail of an enum. + (c-basic-matchers-after): Insert a call to the above new function. + This fixes bug #7264. + +2010-10-30 Glenn Morris <rgm@gnu.org> + + * cus-start.el: Add :set properties for minor modes menu-bar-mode, + tool-bar-mode, transient-mark-mode. (Bug#7306) + Include the :set property in the dumped Emacs. + +2010-10-29 Stefan Monnier <monnier@iro.umontreal.ca> + + SMIE: change indent rules format, improve smie-setup. + * emacs-lisp/smie.el (smie-precs-precedence-table) + (smie-merge-prec2s, smie-bnf-precedence-table, smie-prec2-levels): + Mark them pure so the tables gets built at compile time. + (smie-bnf-precedence-table): Store the closer-alist in the table. + (smie-prec2-levels): Preserve the closer-alist. + (smie-blink-matching-open): Be more forgiving in case of indentation. + (smie-hanging-p): Rename from smie-indent--hanging-p. + (smie-bolp): Rename from smie-indent--bolp. + (smie--parent, smie--after): New dynamic vars. + (smie-parent-p, smie-next-p, smie-prev-p): New funs. + (smie-indent-rules): Remove. + (smie-indent--offset-rule): Remove fun. + (smie-rules-function): New var. + (smie-indent--rule): New fun. + (smie-indent--offset, smie-indent-keyword, smie-indent-after-keyword) + (smie-indent-exps): Use it. + (smie-setup): Setup paren blinking; add keyword args for token + functions; extract closer-alist from op-levels. + (smie-indent-debug-log): Remove var. + (smie-indent-debug): Remove fun. + * progmodes/prolog.el (prolog-smie-indent-rules): Remove. + (prolog-smie-rules): New fun to replace it. + (prolog-mode-variables): Simplify. + * progmodes/octave-mod.el (octave-smie-closer-alist): Remove, now that + it's setup automatically. + (octave-smie-indent-rules): Remove. + (octave-smie-rules): New fun to replace it. + (octave-mode): Simplify. + +2010-10-29 Glenn Morris <rgm@gnu.org> + + * files.el (temporary-file-directory): Remove (already defined in C). + * cus-start.el: Add temporary-file-directory. + + * abbrev.el (abbrev-mode): + * composite.el (auto-composition-mode): + * menu-bar.el (menu-bar-mode): + * simple.el (transient-mark-mode): + * tool-bar.el (tool-bar-mode): Adjust the define-minor-mode calls so + that they do not define the associated variables twice. + * simple.el (transient-mark-mode): Remove defvar. + * composite.el (auto-composition-mode): Make variable auto-buffer-local. + * cus-start.el: Add transient-mark-mode, menu-bar-mode, tool-bar-mode. + Handle multiple groups, and also custom-delayed-init-variables. + * emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix. + +2010-10-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns. + (pcase-if): Add one minor optimization. + (pcase-split-equal): Rename from pcase-split-eq. + (pcase-split-member): Rename from pcase-split-memq. + (pcase-u1): Add strings to the member optimization. + Add `guard' variant of predicates. + (pcase-q1): Add string patterns. + +2010-10-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/log-edit.el (log-edit-rewrite-fixes): State its safety pred. + 2010-10-28 Glenn Morris <rgm@gnu.org> * term/ns-win.el (global-map, menu-bar-final-items, menu-bar-help-menu): @@ -171,13 +350,13 @@ auto-built for efficiency of execution and updating. (verilog-extended-complete-re): Support 'pure' fucntion & task declarations (these have no bodies). - (verilog-beg-of-statement): general cleanup to enable support of - 'pure' fucntion & task declarations (these have no bodies). These - efforts together fix Verilog bug210 from veripool; which was also + (verilog-beg-of-statement): General cleanup to enable support of + 'pure' fucntion & task declarations (these have no bodies). + These efforts together fix Verilog bug210 from veripool; which was also noticed by Steve Pearlmutter. (verilog-directive-re, verilog-directive-begin, verilog-indent-re) - (verilog-directive-nest-re, verilog-set-auto-endcomments): Support - `elsif. Reported by Shankar Giri. + (verilog-directive-nest-re, verilog-set-auto-endcomments): + Support `elsif. Reported by Shankar Giri. (verilog-forward-ws&directives, verilog-in-attribute-p): Fixes for attribute handling for lining up declarations and assignments. (verilog-beg-of-statement-1): Fix issue where continued declaration @@ -185,8 +364,7 @@ (verilog-in-attribute-p, verilog-skip-backward-comments) (verilog-skip-forward-comment-p): Support proper treatment of attributes by indent code. Reported by Jeff Steele. - (verilog-in-directive-p): Fix comment to correctly describe - function. + (verilog-in-directive-p): Fix comment to correctly describe function. (verilog-backward-up-list, verilog-in-struct-region-p) (verilog-backward-token, verilog-in-struct-p) (verilog-in-coverage-p, verilog-do-indent) @@ -213,7 +391,7 @@ parameter in AUTOINSTPARAM. (verilog-read-always-signals-recurse, verilog-read-decls): Fix not treating `elsif similar to `endif inside AUTOSENSE. - (verilog-do-indent): Implement correct automatic or static task or + (verilog-do-indent): Implement correct automatic or static task or function end comment highlight. Reported by Steve Pearlmutter. (verilog-font-lock-keywords-2): Fix highlighting of single character pins, bug264. Reported by Michael Laajanen. @@ -221,15 +399,15 @@ (verilog-read-sub-decls-in-interfaced, verilog-read-sub-decls-sig) (verilog-subdecls-get-interfaced, verilog-subdecls-new): Support interfaces with AUTOINST, bug270. Reported by Luis Gutierrez. - (verilog-pretty-expr): Fix interactive arguments, bug272. Reported - by Mark Johnson. - (verilog-auto-tieoff, verilog-auto-tieoff-ignore-regexp): Add - 'verilog-auto-tieoff-ignore-regexp' for AUTOTIEOFF, + (verilog-pretty-expr): Fix interactive arguments, bug272. + Reported by Mark Johnson. + (verilog-auto-tieoff, verilog-auto-tieoff-ignore-regexp): + Add 'verilog-auto-tieoff-ignore-regexp' for AUTOTIEOFF, bug269. Suggested by Gary Delp. (verilog-mode-map, verilog-preprocess, verilog-preprocess-history) - (verilog-preprocessor, verilog-set-compile-command): Create - verilog-preprocess and verilog-preprocessor to show preprocessed - output. + (verilog-preprocessor, verilog-set-compile-command): + Create verilog-preprocess and verilog-preprocessor to show + preprocessed output. (verilog-get-beg-of-line, verilog-get-end-of-line) (verilog-modi-file-or-buffer, verilog-modi-name) (verilog-modi-point, verilog-within-string): Move defmacro's @@ -277,8 +455,8 @@ (verilog-modi-lookup-last-current, verilog-modi-lookup-last-mod) (verilog-modi-lookup-last-modi, verilog-modi-lookup-last-tick): Fix slow verilog-auto expansion on very large files. - (verilog-read-sub-decls-expr, verilog-read-sub-decls-line): Fix - AUTOOUTPUT treating "1*2" as a signal name in submodule connection + (verilog-read-sub-decls-expr, verilog-read-sub-decls-line): + Fix AUTOOUTPUT treating "1*2" as a signal name in submodule connection "{1*2{...". Broke in last revision. (verilog-read-sub-decls-expr): Fix AUTOOUTPUT not detecting 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." "Toggle Abbrev mode in the current buffer. With optional argument ARG, turn abbrev mode on if ARG is positive, otherwise turn it off. In Abbrev mode, inserting an -abbreviation causes it to expand and be replaced by its expansion.") +abbreviation causes it to expand and be replaced by its expansion." + ;; It's defined in C, this stops the d-m-m macro defining it again. + :variable abbrev-mode) (put 'abbrev-mode 'safe-local-variable 'booleanp) 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 @@ +2010-11-01 Glenn Morris <rgm@gnu.org> + + * semantic/bovine/c.el (semantic-analyze-split-name): Move before use. + + * semantic/symref/cscope.el (ede-toplevel): + * semantic/symref.el (ede-toplevel): + * semantic/tag-file.el (ede-toplevel): + * ede.el (ede-toplevel): Fix declarations. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * ede/proj-elisp.el (project-compile-target): Fix previous change. + * semantic/ede-grammar.el (project-compile-target): Fix previous change. + +2010-10-31 Julien Danjou <julien@danjou.info> + + * ede/proj-elisp.el (project-compile-target): + * semantic/ede-grammar.el (project-compile-target): + Use `byte-recompile-file'. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * mode-local.el (mode-local-augment-function-help): + * semantic/analyze/debug.el (semantic-analyzer-debug-add-buttons): + * semantic/symref/list.el (semantic-symref-results-dump) + (semantic-symref-rb-toggle-expand-tag): Replace inappropriate uses + of toggle-read-only. + 2010-09-30 Chong Yidong <cyd@stupidchicken.com> * 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 @@ ;;; ede.el --- Emacs Development Environment gloss -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -56,7 +56,7 @@ (declare-function ede-directory-project-p "ede/files") (declare-function ede-find-subproject-for-directory "ede/files") (declare-function ede-project-directory-remove-hash "ede/files") -(declare-function ede-toplevel "ede/files") +(declare-function ede-toplevel "ede/base") (declare-function ede-toplevel-project "ede/files") (declare-function ede-up-directory "ede/files") (declare-function semantic-lex-make-spp-table "semantic/lex-spp") @@ -1278,5 +1278,4 @@ is the project to use, instead of `ede-current-project'." (ede-speedbar-file-setup) (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup)) -;; arch-tag: 0e1e0eba-484f-4119-abdb-30951f725705 ;;; 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)." (utd 0)) (mapc (lambda (src) (let* ((fsrc (expand-file-name src dir)) - (elc (concat (file-name-sans-extension fsrc) ".elc")) - ) - (if (or (not (file-exists-p elc)) - (file-newer-than-file-p fsrc elc)) - (progn - (setq comp (1+ comp)) - (byte-compile-file fsrc)) + (elc (concat (file-name-sans-extension fsrc) ".elc"))) + (if (eq (byte-recompile-file fsrc nil 0) t) + (setq comp (1+ comp)) (setq utd (1+ utd))))) (oref obj source)) (message "All Emacs Lisp sources are up to date in %s" (object-name obj)) - (cons comp utd) - )) + (cons comp utd))) (defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version) "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." (provide 'ede/proj-elisp) -;; arch-tag: 3802c94b-d04d-4ecf-9bab-b29ed6e77588 ;;; 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 @@ ;;; mode-local.el --- Support for mode local facilities ;; -;; Copyright (C) 2004, 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; ;; Author: David Ponce <david@dponce.com> ;; Maintainer: David Ponce <david@dponce.com> @@ -610,19 +611,16 @@ PROMPT, INITIAL, HIST, and DEFAULT are the same as for `completing-read'." SYMBOL is a function that can be overridden." (with-current-buffer "*Help*" (pop-to-buffer (current-buffer)) - (unwind-protect - (progn - (toggle-read-only -1) - (goto-char (point-min)) - (unless (re-search-forward "^$" nil t) - (goto-char (point-max)) - (beginning-of-line) - (forward-line -1)) - (insert (overload-docstring-extension symbol) "\n") - ;; NOTE TO SELF: - ;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE - ) - (toggle-read-only 1)))) + (goto-char (point-min)) + (unless (re-search-forward "^$" nil t) + (goto-char (point-max)) + (beginning-of-line) + (forward-line -1)) + (let ((inhibit-read-only t)) + (insert (overload-docstring-extension symbol) "\n") + ;; NOTE TO SELF: + ;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE + ))) ;; Help for mode-local bindings. (defun mode-local-print-binding (symbol) @@ -782,5 +780,4 @@ invoked interactively." (provide 'mode-local) -;; arch-tag: 14b77823-f93c-4b3d-9116-495f69a6ec07 ;;; 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." (set-marker orig-buffer (point) (current-buffer)) ;; Get a buffer ready. (with-current-buffer "*Help*" - (toggle-read-only -1) - (goto-char (point-min)) - (set (make-local-variable 'semantic-analyzer-debug-orig) orig-buffer) - ;; First, add do-in buttons to recommendations. - (while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t) - (let ((fcn (match-string 1))) - (when (not (fboundp (intern-soft fcn))) - (error "Help Err: Can't find %s" fcn)) - (end-of-line) - (insert " ") - (insert-button "[ Do It ]" - 'mouse-face 'custom-button-pressed-face - 'do-fcn fcn - 'action `(lambda (arg) - (let ((M semantic-analyzer-debug-orig)) - (set-buffer (marker-buffer M)) - (goto-char M)) - (call-interactively (quote ,(intern-soft fcn)))) - ) - )) + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (set (make-local-variable 'semantic-analyzer-debug-orig) orig-buffer) + ;; First, add do-in buttons to recommendations. + (while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t) + (let ((fcn (match-string 1))) + (when (not (fboundp (intern-soft fcn))) + (error "Help Err: Can't find %s" fcn)) + (end-of-line) + (insert " ") + (insert-button "[ Do It ]" + 'mouse-face 'custom-button-pressed-face + 'do-fcn fcn + 'action `(lambda (arg) + (let ((M semantic-analyzer-debug-orig)) + (set-buffer (marker-buffer M)) + (goto-char M)) + (call-interactively (quote ,(intern-soft fcn)))))))) ;; Do something else? - ;; Clean up the mess - (toggle-read-only 1) - (set-buffer-modified-p nil) - ))) + (set-buffer-modified-p nil)))) (provide 'semantic/analyze/debug) -;; arch-tag: 943db1e5-47e6-4bec-9989-78ebfadf0358 ;;; 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: where typename is the name of the type, and typeoftype is \"class\" or \"struct\".") +(define-mode-local-override semantic-analyze-split-name c-mode (name) + "Split up tag names on colon (:) boundaries." + (let ((ans (split-string name ":"))) + (if (= (length ans) 1) + name + (delete "" ans)))) + (defun semantic-c-reconstitute-token (tokenpart declmods typedecl) "Reconstitute a token TOKENPART with DECLMODS and TYPEDECL. This 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." (string= (semantic-tag-type type) "enum")) (semantic-tag-type-members type))) -(define-mode-local-override semantic-analyze-split-name c-mode (name) - "Split up tag names on colon (:) boundaries." - (let ((ans (split-string name ":"))) - (if (= (length ans) 1) - name - (delete "" ans)))) - (define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist) "Assemble the list of names NAMELIST into a namespace name." (mapconcat 'identity namelist "::")) @@ -1871,5 +1871,4 @@ For types with a :parent, create faux namespaces to put TAG into." ;; generated-autoload-load-name: "semantic/bovine/c" ;; End: -;; arch-tag: 263951a8-0f18-445d-8e73-eb8f9ac8e2a3 ;;; 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 @@ ;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files -;;; Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -133,11 +134,8 @@ Lays claim to all -by.el, and -wy.el files." (save-excursion (semantic-grammar-create-package)) (save-buffer) - (let ((cf (concat (semantic-grammar-package) ".el"))) - (if (or (not (file-exists-p cf)) - (file-newer-than-file-p src cf)) - (byte-compile-file cf))))) - (oref obj source))) + (byte-recompile-file (concat (semantic-grammar-package) ".el") nil 0))) + (oref obj source))) (message "All Semantic Grammar sources are up to date in %s" (object-name obj))) ;;; Makefile generation functions @@ -197,5 +195,4 @@ Argument THIS is the target that should insert stuff." (provide 'semantic/ede-grammar) -;; arch-tag: 37a06a8d-957a-4fa2-a931-38482d28c24a ;;; 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 @@ (defvar ede-minor-mode) (declare-function data-debug-new-buffer "data-debug") (declare-function data-debug-insert-object-slots "eieio-datadebug") -(declare-function ede-toplevel "ede/files") +(declare-function ede-toplevel "ede/base") (declare-function ede-project-root-directory "ede/files") (declare-function ede-up-directory "ede/files") @@ -508,5 +508,4 @@ over until it returns nil." ;; generated-autoload-load-name: "semantic/symref" ;; End: -;; arch-tag: 928394b7-19ef-4f76-8cb3-37e9a9891984 ;;; 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 @@ (require 'semantic/symref) (defvar ede-minor-mode) -(declare-function ede-toplevel "ede/files") +(declare-function ede-toplevel "ede/base") (declare-function ede-project-root-directory "ede/files") ;;; Code: @@ -91,5 +91,4 @@ Moves cursor to end of the match." ;; generated-autoload-load-name: "semantic/symref/cscope" ;; End: -;; arch-tag: 7c0a4e02-ade4-407a-9df7-4f948bd61a19 ;;; 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'." (defun semantic-symref-results-dump (results) "Dump the RESULTS into the current buffer." ;; Get ready for the insert. - (toggle-read-only -1) - (erase-buffer) - - ;; Insert the contents. - (let ((lastfile nil) - ) - (dolist (T (oref results :hit-tags)) - - (when (not (equal lastfile (semantic-tag-file-name T))) - (setq lastfile (semantic-tag-file-name T)) - (insert-button lastfile - 'mouse-face 'custom-button-pressed-face - 'action 'semantic-symref-rb-goto-file + (let ((inhibit-read-only t)) + (erase-buffer) + ;; Insert the contents. + (let ((lastfile nil)) + (dolist (T (oref results :hit-tags)) + (unless (equal lastfile (semantic-tag-file-name T)) + (setq lastfile (semantic-tag-file-name T)) + (insert-button lastfile + 'mouse-face 'custom-button-pressed-face + 'action 'semantic-symref-rb-goto-file + 'tag T) + (insert "\n")) + (insert " ") + (insert-button "[+]" + 'mouse-face 'highlight + 'face nil + 'action 'semantic-symref-rb-toggle-expand-tag 'tag T - ) - (insert "\n")) - - (insert " ") - (insert-button "[+]" - 'mouse-face 'highlight - 'face nil - 'action 'semantic-symref-rb-toggle-expand-tag - 'tag T - 'state 'closed) - (insert " ") - (insert-button (funcall semantic-symref-results-summary-function - T nil t) - 'mouse-face 'custom-button-pressed-face - 'face nil - 'action 'semantic-symref-rb-goto-tag - 'tag T) - (insert "\n") - - )) - - ;; Auto expand - (when semantic-symref-auto-expand-results - (semantic-symref-list-expand-all)) - - ;; Clean up the mess - (toggle-read-only 1) - (set-buffer-modified-p nil) - ) + 'state 'closed) + (insert " ") + (insert-button (funcall semantic-symref-results-summary-function + T nil t) + 'mouse-face 'custom-button-pressed-face + 'face nil + 'action 'semantic-symref-rb-goto-tag + 'tag T) + (insert "\n"))) + ;; Auto expand + (when semantic-symref-auto-expand-results + (semantic-symref-list-expand-all))) + ;; Clean up the mess + (set-buffer-modified-p nil)) ;;; Commands for semantic-symref-results ;; @@ -283,11 +272,9 @@ BUTTON is the button that was clicked." (buff (semantic-tag-buffer tag)) (hits (semantic--tag-get-property tag :hit)) (state (button-get button 'state)) - (text nil) - ) + (text nil)) (cond ((eq state 'closed) - (toggle-read-only -1) (with-current-buffer buff (dolist (H hits) (goto-char (point-min)) @@ -295,48 +282,42 @@ BUTTON is the button that was clicked." (beginning-of-line) (back-to-indentation) (setq text (cons (buffer-substring (point) (point-at-eol)) text))) - (setq text (nreverse text)) - ) + (setq text (nreverse text))) (goto-char (button-start button)) (forward-char 1) - (delete-char 1) - (insert "-") - (button-put button 'state 'open) - (save-excursion - (end-of-line) - (while text - (insert "\n") - (insert " ") - (insert-button (car text) - 'mouse-face 'highlight - 'face nil - 'action 'semantic-symref-rb-goto-match - 'tag tag - 'line (car hits)) - (setq text (cdr text) - hits (cdr hits)))) - (toggle-read-only 1) - ) + (let ((inhibit-read-only t)) + (delete-char 1) + (insert "-") + (button-put button 'state 'open) + (save-excursion + (end-of-line) + (while text + (insert "\n") + (insert " ") + (insert-button (car text) + 'mouse-face 'highlight + 'face nil + 'action 'semantic-symref-rb-goto-match + 'tag tag + 'line (car hits)) + (setq text (cdr text) + hits (cdr hits)))))) ((eq state 'open) - (toggle-read-only -1) - (button-put button 'state 'closed) - ;; Delete the various bits. - (goto-char (button-start button)) - (forward-char 1) - (delete-char 1) - (insert "+") - (save-excursion - (end-of-line) + (let ((inhibit-read-only t)) + (button-put button 'state 'closed) + ;; Delete the various bits. + (goto-char (button-start button)) (forward-char 1) - (delete-region (point) - (save-excursion - (forward-char 1) - (forward-line (length hits)) - (point)))) - (toggle-read-only 1) - ) - )) - ) + (delete-char 1) + (insert "+") + (save-excursion + (end-of-line) + (forward-char 1) + (delete-region (point) + (save-excursion + (forward-char 1) + (forward-line (length hits)) + (point))))))))) (defun semantic-symref-rb-goto-file (&optional button) "Go to the file specified in the symref results buffer. @@ -554,5 +535,4 @@ Return the number of occurrences FUNCTION was operated upon." ;; generated-autoload-load-name: "semantic/symref/list" ;; End: -;; arch-tag: e355d9c6-26e0-42d1-9bf1-f4801a54fffa ;;; 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 @@ (declare-function semanticdb-table-child-p "semantic/db" t t) (declare-function semanticdb-get-buffer "semantic/db") (declare-function semantic-dependency-find-file-on-path "semantic/dep") -(declare-function ede-toplevel "ede/files") +(declare-function ede-toplevel "ede/base") ;;; Code: @@ -214,5 +214,4 @@ file prototypes belong in." ;; generated-autoload-load-name: "semantic/tag-file" ;; End: -;; arch-tag: 71d4cf18-c1ec-414c-bb0a-c2ed914c1361 ;;; 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 by functions registered in `composition-function-table' (which see). You can use `global-auto-composition-mode' to turn on -Auto Composition mode in all buffers (this is the default).") +Auto Composition mode in all buffers (this is the default)." + ;; It's defined in C, this stops the d-m-m macro defining it again. + :variable auto-composition-mode) +;; It's not defined with DEFVAR_PER_BUFFER though. +(make-variable-buffer-local 'auto-composition-mode) ;;;###autoload (define-minor-mode global-auto-composition-mode @@ -757,5 +761,4 @@ See `auto-composition-mode' for more information on Auto-Composition mode." -;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33 ;;; 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 @@ ;;; cus-start.el --- define customization properties of builtins ;; -;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: internal @@ -34,6 +34,19 @@ ;;; Code: +;; Elements of this list have the form: +;; SYMBOL GROUP TYPE VERSION REST... +;; SYMBOL is the name of the variable. +;; GROUP is the custom group to which it belongs (may also be a list +;; of groups) +;; TYPE is the defcustom :type. +;; VERSION is the defcustom :version (or nil). +;; REST is a set of :KEYWORD VALUE pairs. Accepted :KEYWORDs are: +;; :standard - standard value for SYMBOL (else use current value) +;; :set - custom-set property +;; :risky - risky-local-variable property +;; :safe - safe-local-variable property +;; :tag - custom-tag property (let ((all '(;; alloc.c (gc-cons-threshold alloc integer) (garbage-collection-messages alloc boolean) @@ -97,10 +110,15 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (line-spacing display (choice (const :tag "none" nil) integer) "22.1") (cursor-in-non-selected-windows - cursor boolean nil t :tag "Cursor In Non-selected Windows" + cursor boolean nil + :tag "Cursor In Non-selected Windows" :set #'(lambda (symbol value) (set-default symbol value) (force-mode-line-update t))) + (transient-mark-mode editing-basics boolean nil + :standard (not noninteractive) + :initialize custom-initialize-delay + :set custom-set-minor-mode) ;; callint.c (mark-even-if-inactive editing-basics boolean) ;; callproc.c @@ -171,6 +189,36 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; fileio.c (delete-by-moving-to-trash auto-save boolean "23.1") (auto-save-visited-file-name auto-save boolean) + ;; filelock.c + (temporary-file-directory + ;; Darwin section added 24.1, does not seem worth :version bump. + files directory nil + :standard + (file-name-as-directory + ;; FIXME ? Should there be Ftemporary_file_directory to do this + ;; more robustly (cf set_local_socket in emacsclient.c). + ;; It could be used elsewhere, eg Fcall_process_region, + ;; server-socket-dir. See bug#7135. + (cond ((memq system-type '(ms-dos windows-nt)) + (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") + "c:/temp")) + ((eq system-type 'darwin) + (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") + ;; See bug#7135. + (let ((tmp (ignore-errors + (shell-command-to-string + "getconf DARWIN_USER_TEMP_DIR")))) + (and (stringp tmp) + (setq tmp (replace-regexp-in-string + "\n\\'" "" tmp)) + ;; Handles "getconf: Unrecognized variable..." + (file-directory-p tmp) + tmp)) + "/tmp")) + (t + (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") + "/tmp")))) + :initialize custom-initialize-delay) ;; fns.c (use-dialog-box menu boolean "21.1") (use-file-dialog menu boolean "22.1") @@ -185,6 +233,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (other :tag "hidden by keypress" 1)) "22.1") (make-pointer-invisible mouse boolean "23.2") + (menu-bar-mode frames boolean nil + ;; FIXME? +; :initialize custom-initialize-default + :set custom-set-minor-mode) + (tool-bar-mode (frames mouse) boolean nil +; :initialize custom-initialize-default + :set custom-set-minor-mode) ;; fringe.c (overflow-newline-into-fringe fringe boolean) ;; indent.c @@ -332,7 +387,7 @@ since it could result in memory overflow and make Emacs crash." (other :tag "Always" t)) "23.1") ;; xdisp.c - (show-trailing-whitespace whitespace-faces boolean nil nil + (show-trailing-whitespace whitespace-faces boolean nil :safe booleanp) (scroll-step windows integer) (scroll-conservatively windows integer) @@ -408,13 +463,13 @@ since it could result in memory overflow and make Emacs crash." group (nth 1 this) type (nth 2 this) version (nth 3 this) + rest (nthcdr 4 this) ;; If we did not specify any standard value expression above, ;; use the current value as the standard value. - standard (if (nthcdr 4 this) - (nth 4 this) - (when (default-boundp symbol) - (funcall quoter (default-value symbol)))) - rest (nthcdr 5 this) + standard (if (setq prop (memq :standard rest)) + (cadr prop) + (if (default-boundp symbol) + (funcall quoter (default-value symbol)))) ;; Don't complain about missing variables which are ;; irrelevant to this platform. native-p (save-match-data @@ -452,21 +507,28 @@ since it could result in memory overflow and make Emacs crash." (put symbol 'safe-local-variable (cadr prop))) (if (setq prop (memq :risky rest)) (put symbol 'risky-local-variable (cadr prop))) - ;; If this is NOT while dumping Emacs, - ;; set up the rest of the customization info. + (if (setq prop (memq :set rest)) + (put symbol 'custom-set (cadr prop))) + ;; Note this is the _only_ initialize property we handle. + (if (eq (cadr (memq :initialize rest)) 'custom-initialize-delay) + (push symbol custom-delayed-init-variables)) + ;; If this is NOT while dumping Emacs, set up the rest of the + ;; customization info. This is the stuff that is not needed + ;; until someone does M-x customize etc. (unless purify-flag - ;; Add it to the right group. - (custom-add-to-group group symbol 'custom-variable) + ;; Add it to the right group(s). + (if (listp group) + (dolist (g group) + (custom-add-to-group g symbol 'custom-variable)) + (custom-add-to-group group symbol 'custom-variable)) ;; Set the type. (put symbol 'custom-type type) - (put symbol 'custom-version version) + (if version (put symbol 'custom-version version)) (while rest (setq prop (car rest) propval (cadr rest) rest (nthcdr 2 rest)) - (cond ((memq prop '(:risky :safe))) ; handled above - ((eq prop :set) - (put symbol 'custom-set propval)) + (cond ((memq prop '(:standard :risky :safe :set))) ; handled above ((eq prop :tag) (put symbol 'custom-tag propval)))))))) 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 @@ ;; ======================================================================== ;; Entry points: ;; byte-recompile-directory, byte-compile-file, +;; byte-recompile-file, ;; batch-byte-compile, batch-byte-recompile-directory, ;; byte-compile, compile-defun, ;; display-call-tree @@ -1551,23 +1552,10 @@ that already has a `.elc' file." (not (auto-save-file-name-p bytecomp-source)) (not (string-equal dir-locals-file (file-name-nondirectory - bytecomp-source))) - (setq bytecomp-dest - (byte-compile-dest-file bytecomp-source)) - (if (file-exists-p bytecomp-dest) - ;; File was already compiled. - (or bytecomp-force - (file-newer-than-file-p bytecomp-source - bytecomp-dest)) - ;; No compiled file exists yet. - (and bytecomp-arg - (or (eq 0 bytecomp-arg) - (y-or-n-p (concat "Compile " - bytecomp-source "? ")))))) - (progn (if (and noninteractive (not byte-compile-verbose)) - (message "Compiling %s..." bytecomp-source)) - (let ((bytecomp-res (byte-compile-file - bytecomp-source))) + bytecomp-source)))) + (progn (let ((bytecomp-res (byte-recompile-file + bytecomp-source + bytecomp-force bytecomp-arg))) (cond ((eq bytecomp-res 'no-byte-compile) (setq skip-count (1+ skip-count))) ((eq bytecomp-res t) @@ -1595,6 +1583,59 @@ This is normally set in local file variables at the end of the elisp file: ;; Local Variables:\n;; no-byte-compile: t\n;; End: ") ;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp) +(defun byte-recompile-file (bytecomp-filename &optional bytecomp-force bytecomp-arg load) + "Recompile BYTECOMP-FILENAME file if it needs recompilation. +This happens when its `.elc' file is older than itself. + +If the `.elc' file exists and is up-to-date, normally this +function *does not* compile BYTECOMP-FILENAME. However, if the +prefix argument BYTECOMP-FORCE is set, that means do compile +BYTECOMP-FILENAME even if the destination already exists and is +up-to-date. + +If the `.elc' file does not exist, normally this function *does +not* compile BYTECOMP-FILENAME. If BYTECOMP-ARG is 0, that means +compile the file even if it has never been compiled before. +A nonzero BYTECOMP-ARG means ask the user. + +If LOAD is set, `load' the file after compiling. + +The value returned is the value returned by `byte-compile-file', +or 'no-byte-compile if the file did not need recompilation." + (interactive + (let ((bytecomp-file buffer-file-name) + (bytecomp-file-name nil) + (bytecomp-file-dir nil)) + (and bytecomp-file + (eq (cdr (assq 'major-mode (buffer-local-variables))) + 'emacs-lisp-mode) + (setq bytecomp-file-name (file-name-nondirectory bytecomp-file) + bytecomp-file-dir (file-name-directory bytecomp-file))) + (list (read-file-name (if current-prefix-arg + "Byte compile file: " + "Byte recompile file: ") + bytecomp-file-dir bytecomp-file-name nil) + current-prefix-arg))) + (let ((bytecomp-dest + (byte-compile-dest-file bytecomp-filename)) + ;; Expand now so we get the current buffer's defaults + (bytecomp-filename (expand-file-name bytecomp-filename))) + (if (if (file-exists-p bytecomp-dest) + ;; File was already compiled + ;; Compile if forced to, or filename newer + (or bytecomp-force + (file-newer-than-file-p bytecomp-filename + bytecomp-dest)) + (or (eq 0 bytecomp-arg) + (y-or-n-p (concat "Compile " + bytecomp-filename "? ")))) + (progn + (if (and noninteractive (not byte-compile-verbose)) + (message "Compiling %s..." bytecomp-filename)) + (byte-compile-file bytecomp-filename load)) + (when load (load bytecomp-filename)) + 'no-byte-compile))) + ;;;###autoload (defun byte-compile-file (bytecomp-filename &optional load) "Compile a file of Lisp code named BYTECOMP-FILENAME into a file of byte code. @@ -4308,5 +4349,4 @@ and corresponding effects." (run-hooks 'bytecomp-load-hook) -;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a ;;; 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. of the variable MODE to store the state of the mode. PLACE can also be of the form (GET . SET) where GET is an expression that returns the current state and SET is a function that takes - a new state and sets it. + a new state and sets it. If you specify a :variable, this + function assumes it is defined elsewhere. For example, you could write (define-minor-mode foo-mode \"If enabled, foo on you!\" @@ -196,6 +197,7 @@ For example, you could write `(:group ',(intern (replace-regexp-in-string "-mode\\'" "" mode-name))))) + ;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode. (unless type (setq type '(:type 'boolean))) `(progn @@ -583,5 +585,4 @@ BODY is executed after moving to the destination location." (provide 'easy-mmode) -;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a ;;; 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.") (if (and (buffer-modified-p) (y-or-n-p (format "Save buffer %s first? " (buffer-name)))) (save-buffer)) - (let ((compiled-file-name (byte-compile-dest-file buffer-file-name))) - (if (file-newer-than-file-p compiled-file-name buffer-file-name) - (load-file compiled-file-name) - (byte-compile-file buffer-file-name t)))) + (byte-recompile-file buffer-file-name nil 0 t)) (defcustom emacs-lisp-mode-hook nil "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." (defun describe-package (package) "Display the full documentation of PACKAGE (a symbol)." (interactive - (let* ((packages (append (mapcar 'car package-alist) + (let* ((guess (function-called-at-point)) + packages val) + ;; Initialize the package system if it's not. + (unless package-alist + (package-initialize)) + (setq packages (append (mapcar 'car package-alist) (mapcar 'car package-archive-contents))) - (guess (function-called-at-point)) - val) (unless (memq guess packages) (setq guess nil)) (setq packages (mapcar 'symbol-name packages)) @@ -1617,6 +1620,9 @@ list; the default is to display everything in `package-alist'." Fetches the updated list of packages before displaying. The list is displayed in a buffer named `*Packages*'." (interactive) + ;; Initialize the package system if necessary. + (unless package-alist + (package-initialize)) (package-refresh-contents) (package--list-packages)) 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 @@ ;; ML-style pattern matching. ;; The entry points are autoloaded. +;; Todo: + +;; - provide ways to extend the set of primitives, with some kind of +;; define-pcase-matcher. We could easily make it so that (guard BOOLEXP) +;; could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)). +;; But better would be if we could define new ways to match by having the +;; extension provide its own `pcase-split-<foo>' thingy. +;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to +;; generate a lex-style DFA to decide whether to run E1 or E2. + ;;; Code: (eval-when-compile (require 'cl)) @@ -48,10 +58,12 @@ UPatterns can take the following forms: (and UPAT...) matches if all the patterns match. `QPAT matches if the QPattern QPAT matches. (pred PRED) matches if PRED applied to the object returns non-nil. + (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. QPatterns can take the following forms: (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. ,UPAT matches if the UPattern UPAT matches. + STRING matches if the object is `equal' to STRING. ATOM matches if the object is `eq' to ATOM. QPatterns for vectors are not implemented yet. @@ -77,6 +89,8 @@ of the form (UPAT EXP)." (if (null bindings) body `(pcase ,(cadr (car bindings)) (,(caar bindings) (pcase-let* ,(cdr bindings) ,body)) + ;; FIXME: In many cases `dontcare' would be preferable, so maybe we + ;; should have `let' and `elet', like we have `case' and `ecase'. (t (error "Pattern match failure in `pcase-let'"))))) ;;;###autoload @@ -167,12 +181,19 @@ of the form (UPAT EXP)." (cond ((eq else :pcase-dontcare) then) ((eq (car-safe else) 'if) - `(cond (,test ,then) - (,(nth 1 else) ,(nth 2 else)) - (t ,@(nthcdr 3 else)))) + (if (equal test (nth 1 else)) + ;; Doing a test a second time: get rid of the redundancy. + ;; FIXME: ideally, this should never happen because the pcase-split-* + ;; functions should have eliminated such things, but pcase-split-member + ;; is imprecise, so in practice it does happen occasionally. + `(if ,test ,then ,@(nthcdr 3 else)) + `(cond (,test ,then) + (,(nth 1 else) ,(nth 2 else)) + (t ,@(nthcdr 3 else))))) ((eq (car-safe else) 'cond) `(cond (,test ,then) - ,@(cdr else))) + ;; Doing a test a second time: get rid of the redundancy, as above. + ,@(remove (assoc test else) (cdr else)))) (t `(if ,test ,then ,else)))) (defun pcase-upat (qpattern) @@ -276,7 +297,7 @@ MATCH is the pattern that needs to be matched, of the form: ;; A QPattern but not for a cons, can only go the `else' side. ((eq (car-safe pat) '\`) (cons :pcase-fail nil)))) -(defun pcase-split-eq (elem pat) +(defun pcase-split-equal (elem pat) (cond ;; The same match will give the same result. ((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: ) (cons :pcase-fail nil)))) -(defun pcase-split-memq (elems pat) - ;; Based on pcase-split-eq. +(defun pcase-split-member (elems pat) + ;; Based on pcase-split-equal. (cond - ;; The same match will give the same result, but we don't know how - ;; to check it. + ;; The same match (or a match of membership in a superset) will + ;; give the same result, but we don't know how to check it. ;; (??? ;; (cons :pcase-succeed nil)) ;; 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 (if (and (eq (car alt) 'match) (eq var (cadr alt)) (let ((upat (cddr alt))) (and (eq (car-safe upat) '\`) - (or (integerp (cadr upat)) (symbolp (cadr upat)))))) + (or (integerp (cadr upat)) (symbolp (cadr upat)) + (stringp (cadr upat)))))) (push (cddr alt) simples) (push alt others)))) (cond @@ -380,17 +402,19 @@ and otherwise defers to REST which is a list of branches of the form ((memq upat '(t _)) (pcase-u1 matches code vars rest)) ((eq upat 'dontcare) :pcase-dontcare) ((functionp upat) (error "Feature removed, use (pred %s)" upat)) - ((eq (car-safe upat) 'pred) + ((memq (car-safe upat) '(guard pred)) (destructuring-bind (then-rest &rest else-rest) (pcase-split-rest sym (apply-partially 'pcase-split-pred upat) rest) - (pcase-if (if (symbolp (cadr upat)) + (pcase-if (if (and (eq (car upat) 'pred) (symbolp (cadr upat))) `(,(cadr upat) ,sym) (let* ((exp (cadr upat)) ;; `vs' is an upper bound on the vars we need. (vs (pcase-fgrep (mapcar #'car vars) exp)) - (call (if (functionp exp) - `(,exp ,sym) `(,@exp ,sym)))) + (call (cond + ((eq 'guard (car upat)) exp) + ((functionp exp) `(,exp ,sym)) + (t `(,@exp ,sym))))) (if (null vs) call ;; 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 ((eq (car-safe upat) '\`) (pcase-q1 sym (cadr upat) matches code vars rest)) ((eq (car-safe upat) 'or) - (let ((all (> (length (cdr upat)) 1))) + (let ((all (> (length (cdr upat)) 1)) + (memq-fine t)) (when all (dolist (alt (cdr upat)) (unless (and (eq (car-safe alt) '\`) - (or (symbolp (cadr alt)) (integerp (cadr alt)))) + (or (symbolp (cadr alt)) (integerp (cadr alt)) + (setq memq-fine nil) + (stringp (cadr alt)))) (setq all nil)))) (if all ;; Use memq for (or `a `b `c `d) rather than a big tree. (let ((elems (mapcar 'cadr (cdr upat)))) (destructuring-bind (then-rest &rest else-rest) (pcase-split-rest - sym (apply-partially 'pcase-split-memq elems) rest) - (pcase-if `(memq ,sym ',elems) + sym (apply-partially 'pcase-split-member elems) rest) + (pcase-if `(,(if memq-fine #'memq #'member) ,sym ',elems) (pcase-u1 matches code vars then-rest) (pcase-u else-rest)))) (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 ,@matches) code vars then-rest)) (pcase-u else-rest))))) - ((or (integerp qpat) (symbolp qpat)) + ((or (integerp qpat) (symbolp qpat) (stringp qpat)) (destructuring-bind (then-rest &rest else-rest) - (pcase-split-rest sym (apply-partially 'pcase-split-eq qpat) rest) - (pcase-if `(eq ,sym ',qpat) + (pcase-split-rest sym (apply-partially 'pcase-split-equal qpat) rest) + (pcase-if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat) (pcase-u1 matches code vars then-rest) (pcase-u else-rest)))) (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 @@ (eval-when-compile (require 'cl)) +(defgroup smie nil + "Simple Minded Indentation Engine." + :group 'languages) + (defvar comment-continue) (declare-function comment-string-strip "newcomment" (str beforep afterp)) @@ -109,6 +113,7 @@ (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))) (puthash key val table)))) +(put 'smie-precs-precedence-table 'pure t) (defun smie-precs-precedence-table (precs) "Compute a 2D precedence table from a list of precedences. PRECS 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." (smie-set-prec2tab prec2-table other-op op op1))))))) prec2-table)) +(put 'smie-merge-prec2s 'pure t) (defun smie-merge-prec2s (&rest tables) (if (null (cdr tables)) (car tables) @@ -147,6 +153,7 @@ one of those elements share the same precedence level and associativity." table)) prec2))) +(put 'smie-bnf-precedence-table 'pure t) (defun smie-bnf-precedence-table (bnf &rest precs) (let ((nts (mapcar 'car bnf)) ;Non-terminals (first-ops-table ()) @@ -233,6 +240,7 @@ one of those elements share the same precedence level and associativity." ;; Keep track of which tokens are openers/closer, so they can get a nil ;; precedence in smie-prec2-levels. (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2) + (puthash :smie-closer-alist (smie-bnf-closer-alist bnf) prec2) prec2)) ;; (defun smie-prec2-closer-alist (prec2 include-inners) @@ -377,6 +385,7 @@ CSTS is a list of pairs representing arcs in a graph." (append names (list (car names))) " < "))) +(put 'smie-prec2-levels 'pure t) (defun smie-prec2-levels (prec2) ;; FIXME: Rather than only return an alist of precedence levels, we should ;; also extract other useful data from it: @@ -479,6 +488,8 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or (eq 'closer (cdr (assoc (car x) classification-table)))) (setf (nth 2 x) i) (incf i))))) ;See other (incf i) above. + (let ((ca (gethash :smie-closer-alist prec2))) + (when ca (push (cons :smie-closer-alist ca) table))) table)) ;;; Parsing using a precedence level table. @@ -783,7 +794,8 @@ I.e. a good choice can be: (defcustom smie-blink-matching-inners t "Whether SMIE should blink to matching opener for inner keywords. If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." - :type 'boolean) + :type 'boolean + :group 'smie) (defun smie-blink-matching-check (start end) (save-excursion @@ -803,14 +815,22 @@ If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\" (defun smie-blink-matching-open () "Blink the matching opener when applicable. This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'." + (let ((pos (point)) ;Position after the close token. + token) (when (and blink-matching-paren smie-closer-alist ; Optimization. - (eq (char-before) last-command-event) ; Sanity check. + (or (eq (char-before) last-command-event) ;; Sanity check. + (save-excursion + (or (progn (skip-chars-backward " \t") + (setq pos (point)) + (eq (char-before) last-command-event)) + (progn (skip-chars-backward " \n\t") + (setq pos (point)) + (eq (char-before) last-command-event))))) (memq last-command-event smie-blink-matching-triggers) (not (nth 8 (syntax-ppss)))) (save-excursion - (let ((pos (point)) - (token (funcall smie-backward-token-function))) + (setq token (funcall smie-backward-token-function)) (when (and (eq (point) (1- pos)) (= 1 (length token)) (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'. ;; closers (e.g. ?\; in Octave mode), so go back to the ;; previous token. (setq pos (point)) - (setq token (save-excursion - (funcall smie-backward-token-function)))) + (setq token (funcall smie-backward-token-function))) (when (rassoc token smie-closer-alist) ;; We're after a close token. Let's still make sure we ;; didn't skip a comment to find that token. (funcall smie-forward-token-function) (when (and (save-excursion - ;; Trigger can be SPC, or reindent. - (skip-chars-forward " \n\t") + ;; Skip the trigger char, if applicable. + (if (eq (char-after) last-command-event) + (forward-char 1)) + (if (eq ?\n last-command-event) + ;; Skip any auto-indentation, if applicable. + (skip-chars-forward " \t")) (>= (point) pos)) - ;; If token ends with a trigger char, so don't blink for + ;; If token ends with a trigger char, don't blink for ;; anything else than this trigger char, lest we'd blink ;; both when inserting the trigger char and when ;; 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'. (defcustom smie-indent-basic 4 "Basic amount of indentation." - :type 'integer) - -(defvar smie-indent-rules 'unset - ;; TODO: For SML, we need more rule formats, so as to handle - ;; structure Foo = - ;; Bar (toto) - ;; and - ;; structure Foo = - ;; struct ... end - ;; I.e. the indentation after "=" depends on the parent ("structure") - ;; as well as on the following token ("struct"). - "Rules of the following form. -\((:before . TOK) . OFFSET-RULES) how to indent TOK itself. -\(TOK . OFFSET-RULES) how to indent right after TOK. -\(list-intro . TOKENS) declare TOKENS as being followed by what may look like - a funcall but is just a sequence of expressions. -\(t . OFFSET) basic indentation step. -\(args . OFFSET) indentation of arguments. -\((T1 . T2) OFFSET) like ((:before . T2) (:parent T1 OFFSET)). - -OFFSET-RULES is a list of elements which can each either be: - -\(:hanging . OFFSET-RULES) if TOK is hanging, use OFFSET-RULES. -\(:parent PARENT . OFFSET-RULES) if TOK's parent is PARENT, use OFFSET-RULES. -\(:next TOKEN . OFFSET-RULES) if TOK is followed by TOKEN, use OFFSET-RULES. -\(:prev TOKEN . OFFSET-RULES) if TOK is preceded by TOKEN, use -\(:bolp . OFFSET-RULES) If TOK is first on a line, use OFFSET-RULES. -OFFSET the offset to use. - -PARENT can be either the name of the parent or a list of such names. + :type 'integer + :group 'smie) + +(defvar smie-rules-function 'ignore + "Function providing the indentation rules. +It takes two arguments METHOD and ARG where the meaning of ARG +and the expected return value depends on METHOD. +METHOD can be: +- :after, in which case ARG is a token and the function should return the + OFFSET to use for indentation after ARG. +- :before, in which case ARG is a token and the function should return the + OFFSET to use to indent ARG itself. +- :elem, in which case the function should return either: + - the offset to use to indent function arguments (ARG = `arg') + - the basic indentation step (ARG = `basic'). +- :list-intro, in which case ARG is a token and the function should return + non-nil if TOKEN is followed by a list of expressions (not separated by any + token) rather than an expression. + +When ARG is a token, the function is called with point just before that token. +A return value of nil always means to fallback on the default behavior, so the +function should return nil for arguments it does not expect. OFFSET can be of the form: `point' align with the token. @@ -886,91 +901,69 @@ NUMBER offset by NUMBER. \(+ OFFSETS...) use the sum of OFFSETS. VARIABLE use the value of VARIABLE as offset. -The precise meaning of `point' depends on various details: it can -either mean the position of the token we're indenting, or the -position of its parent, or the position right after its parent. - -A nil offset for indentation after an opening token defaults -to `smie-indent-basic'.") +This function will often use some of the following functions designed +specifically for it: +`smie-bolp', `smie-hanging-p', `smie-parent-p', `smie-next-p', `smie-prev-p'.") -(defun smie-indent--hanging-p () - ;; A hanging keyword is one that's at the end of a line except it's not at - ;; the beginning of a line. - (and (save-excursion +(defun smie-hanging-p () + "Return non-nil if the current token is \"hanging\". +A hanging keyword is one that's at the end of a line except it's not at +the beginning of a line." + (and (not (smie-bolp)) + (save-excursion (when (zerop (length (funcall smie-forward-token-function))) ;; Could be an open-paren. (forward-char 1)) (skip-chars-forward " \t") - (eolp)) - (not (smie-indent--bolp)))) + (eolp)))) -(defun smie-indent--bolp () +(defun smie-bolp () + "Return non-nil if the current token is the first on the line." (save-excursion (skip-chars-backward " \t") (bolp))) +(defvar smie--parent) (defvar smie--after) ;Dynamically scoped. + +(defun smie-parent-p (&rest parents) + "Return non-nil if the current token's parent is among PARENTS. +Only meaningful when called from within `smie-rules-function'." + (member (nth 2 (or smie--parent + (save-excursion + (let* ((pos (point)) + (tok (funcall smie-forward-token-function))) + (unless (cadr (assoc tok smie-op-levels)) + (goto-char pos)) + (setq smie--parent + (smie-backward-sexp 'halfsexp)))))) + parents)) + +(defun smie-next-p (&rest tokens) + "Return non-nil if the next token is among TOKENS. +Only meaningful when called from within `smie-rules-function'." + (let ((next + (save-excursion + (unless smie--after + (smie-indent-forward-token) (setq smie--after (point))) + (goto-char smie--after) + (smie-indent-forward-token)))) + (member (car next) tokens))) + +(defun smie-prev-p (&rest tokens) + "Return non-nil if the previous token is among TOKENS." + (let ((prev (save-excursion + (smie-indent-backward-token)))) + (member (car prev) tokens))) + + (defun smie-indent--offset (elem) - (or (cdr (assq elem smie-indent-rules)) - (cdr (assq t smie-indent-rules)) + (or (funcall smie-rules-function :elem elem) + (if (not (eq elem 'basic)) + (funcall smie-rules-function :elem 'basic)) smie-indent-basic)) -(defvar smie-indent-debug-log) - -(defun smie-indent--offset-rule (tokinfo &optional after parent) - "Apply the OFFSET-RULES in TOKINFO. -Point is expected to be right in front of the token corresponding to TOKINFO. -If computing the indentation after the token, then AFTER is the position -after the token, otherwise it should be nil. -PARENT if non-nil should be the parent info returned by `smie-backward-sexp'." - (let ((rules (cdr tokinfo)) - next prev - offset) - (while (consp rules) - (let ((rule (pop rules))) - (cond - ((not (consp rule)) (setq offset rule)) - ((eq (car rule) '+) (setq offset rule)) - ((eq (car rule) :hanging) - (when (smie-indent--hanging-p) - (setq rules (cdr rule)))) - ((eq (car rule) :bolp) - (when (smie-indent--bolp) - (setq rules (cdr rule)))) - ((eq (car rule) :eolp) - (unless after - (error "Can't use :eolp in :before indentation rules")) - (when (> after (line-end-position)) - (setq rules (cdr rule)))) - ((eq (car rule) :prev) - (unless prev - (save-excursion - (setq prev (smie-indent-backward-token)))) - (when (equal (car prev) (cadr rule)) - (setq rules (cddr rule)))) - ((eq (car rule) :next) - (unless next - (unless after - (error "Can't use :next in :before indentation rules")) - (save-excursion - (goto-char after) - (setq next (smie-indent-forward-token)))) - (when (equal (car next) (cadr rule)) - (setq rules (cddr rule)))) - ((eq (car rule) :parent) - (unless parent - (save-excursion - (if after (goto-char after)) - (setq parent (smie-backward-sexp 'halfsexp)))) - (when (if (listp (cadr rule)) - (member (nth 2 parent) (cadr rule)) - (equal (nth 2 parent) (cadr rule))) - (setq rules (cddr rule)))) - (t (error "Unknown rule %s for indentation of %s" - rule (car tokinfo)))))) - ;; If `offset' is not set yet, use `rules' to handle the case where - ;; the tokinfo uses the old-style ((PARENT . TOK). OFFSET). - (unless offset (setq offset rules)) - (when (boundp 'smie-indent-debug-log) - (push (list (point) offset tokinfo) smie-indent-debug-log)) - offset)) +(defun smie-indent--rule (kind token &optional after parent) + (let ((smie--parent parent) + (smie--after after)) + (funcall smie-rules-function kind token))) (defun smie-indent--column (offset &optional base parent virtual-point) "Compute the actual column to use for a given OFFSET. @@ -1012,6 +1005,9 @@ If VIRTUAL-POINT is non-nil, then `point' is virtual." (if (consp parent) (goto-char (cadr parent))) (smie-indent-virtual)) ((eq offset nil) nil) + ;; FIXME: would be good to get rid of this since smie-rules-function + ;; can usually do the lookup trivially, but in cases where + ;; smie-rules-function returns (+ point VAR) it's not nearly as trivial. ((and (symbolp offset) (boundp 'offset)) (smie-indent--column (symbol-value offset) base parent virtual-point)) (t (error "Unknown indentation offset %s" offset)))) @@ -1046,11 +1042,11 @@ This is used when we're not trying to indent point but just need to compute the column at which point should be indented in order to figure out the indentation of some other (further down) point." ;; Trust pre-existing indentation on other lines. - (if (smie-indent--bolp) (current-column) (smie-indent-calculate))) + (if (smie-bolp) (current-column) (smie-indent-calculate))) (defun smie-indent-fixindent () ;; Obey the `fixindent' special comment. - (and (smie-indent--bolp) + (and (smie-bolp) (save-excursion (comment-normalize-vars) (re-search-forward (concat comment-start-skip @@ -1090,43 +1086,31 @@ in order to figure out the indentation of some other (further down) point." (save-excursion (goto-char pos) ;; Different cases: - ;; - smie-indent--bolp: "indent according to others". + ;; - smie-bolp: "indent according to others". ;; - common hanging: "indent according to others". ;; - SML-let hanging: "indent like parent". ;; - if-after-else: "indent-like parent". ;; - middle-of-line: "trust current position". (cond ((null (cdr toklevels)) nil) ;Not a keyword. - ((smie-indent--bolp) + ((smie-bolp) ;; For an open-paren-like thingy at BOL, always indent only ;; based on other rules (typically smie-indent-after-keyword). nil) (t ;; We're only ever here for virtual-indent, which is why ;; we can use (current-column) as answer for `point'. - (let* ((tokinfo (or (assoc (cons :before token) - smie-indent-rules) + (let* ((offset (or (smie-indent--rule :before token) ;; By default use point unless we're hanging. - `((:before . ,token) (:hanging nil) point))) - ;; (after (prog1 (point) (goto-char pos))) - (offset (smie-indent--offset-rule tokinfo))) + (unless (smie-hanging-p) 'point)))) (smie-indent--column offset))))) ;; FIXME: This still looks too much like black magic!! - ;; FIXME: Rather than a bunch of rules like (PARENT . TOKEN), we - ;; want a single rule for TOKEN with different cases for each PARENT. (let* ((parent (smie-backward-sexp 'halfsexp)) - (tokinfo - (or (assoc (cons (caddr parent) token) - smie-indent-rules) - (assoc (cons :before token) smie-indent-rules) - ;; Default rule. - `((:before . ,token) - ;; (:parent open 0) - point))) (offset (save-excursion (goto-char pos) - (smie-indent--offset-rule tokinfo nil parent)))) + (or (smie-indent--rule :before token nil parent) + 'point)))) ;; Different behaviors: ;; - align with parent. ;; - parent + offset. @@ -1151,10 +1135,10 @@ in order to figure out the indentation of some other (further down) point." nil) ((eq (car parent) (car toklevels)) ;; We bumped into a same-level operator. align with it. - (if (and (smie-indent--bolp) (/= (point) pos) + (if (and (smie-bolp) (/= (point) pos) (save-excursion (goto-char (goto-char (cadr parent))) - (not (smie-indent--bolp))) + (not (smie-bolp))) ;; Check the offset of `token' rather then its parent ;; because its parent may have used a special rule. E.g. ;; function foo; @@ -1190,8 +1174,8 @@ in order to figure out the indentation of some other (further down) point." ;; -> d ;; So as to align with the earliest appropriate place. (smie-indent-virtual))) - (tokinfo - (if (and (= (point) pos) (smie-indent--bolp) + (t + (if (and (= (point) pos) (smie-bolp) (or (eq offset 'point) (and (consp offset) (memq 'point offset)))) ;; 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." ;; Don't do it for virtual indentations. We should normally never be "in ;; front of a comment" when doing virtual-indentation anyway. And if we are ;; (as can happen in octave-mode), moving forward can lead to inf-loops. - (and (smie-indent--bolp) + (and (smie-bolp) (let ((pos (point))) (save-excursion (beginning-of-line) @@ -1254,27 +1238,18 @@ in order to figure out the indentation of some other (further down) point." (save-excursion (let* ((pos (point)) (toklevel (smie-indent-backward-token)) - (tok (car toklevel)) - (tokinfo (assoc tok smie-indent-rules))) - ;; Set some default indent rules. - (if (and toklevel (null (cadr toklevel)) (null tokinfo)) - (setq tokinfo (list (car toklevel)))) - ;; (if (and tokinfo (null toklevel)) - ;; (error "Token %S has indent rule but has no parsing info" tok)) + (tok (car toklevel))) (when toklevel - (unless tokinfo - ;; The default indentation after a keyword/operator is 0 for - ;; infix and t for prefix. - ;; Using the BNF syntax, we could come up with better - ;; defaults, but we only have the precedence levels here. - (setq tokinfo (list tok 'default-rule - (if (cadr toklevel) 0 (smie-indent--offset t))))) (let ((offset - (or (smie-indent--offset-rule tokinfo pos) - (smie-indent--offset t)))) - (let ((before (point))) + (or (smie-indent--rule :after tok pos) + ;; The default indentation after a keyword/operator is + ;; 0 for infix and t for prefix. + (if (or (null (cadr toklevel)) + (rassoc tok smie-closer-alist)) + (smie-indent--offset 'basic) 0))) + (before (point))) (goto-char pos) - (smie-indent--column offset before))))))) + (smie-indent--column offset before)))))) (defun smie-indent-exps () ;; Indentation of sequences of simple expressions without @@ -1297,13 +1272,14 @@ in order to figure out the indentation of some other (further down) point." arg) (while (and (null (car (smie-backward-sexp))) (push (point) positions) - (not (smie-indent--bolp)))) + (not (smie-bolp)))) (save-excursion ;; Figure out if the atom we just skipped is an argument rather ;; than a function. - (setq arg (or (null (car (smie-backward-sexp))) - (member (funcall smie-backward-token-function) - (cdr (assoc 'list-intro smie-indent-rules)))))) + (setq arg + (or (null (car (smie-backward-sexp))) + (funcall smie-rules-function :list-intro + (funcall smie-backward-token-function))))) (cond ((null positions) ;; 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.") (save-excursion (indent-line-to indent)) (indent-line-to indent))))) -(defun smie-indent-debug () - "Show the rules used to compute indentation of current line." - (interactive) - (let ((smie-indent-debug-log '())) - (smie-indent-calculate) - ;; FIXME: please improve! - (message "%S" smie-indent-debug-log))) - -(defun smie-setup (op-levels indent-rules) - (set (make-local-variable 'smie-indent-rules) indent-rules) +(defun smie-setup (op-levels rules-function &rest keywords) + "Setup SMIE navigation and indentation. +OP-LEVELS is a grammar table generated by `smie-prec2-levels'. +RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'. +KEYWORDS are additional arguments, which can use the following keywords: +- :forward-token FUN +- :backward-token FUN" + (set (make-local-variable 'smie-rules-function) rules-function) (set (make-local-variable 'smie-op-levels) op-levels) - (set (make-local-variable 'indent-line-function) 'smie-indent-line)) + (set (make-local-variable 'indent-line-function) 'smie-indent-line) + (set (make-local-variable 'forward-sexp-function) + 'smie-forward-sexp-command) + (while keywords + (let ((k (pop keywords)) + (v (pop keywords))) + (case k + (:forward-token + (set (make-local-variable 'smie-forward-token-function) v)) + (:backward-token + (set (make-local-variable 'smie-backward-token-function) v)) + (t (message "smie-setup: ignoring unknown keyword %s" k))))) + (let ((ca (cdr (assq :smie-closer-alist op-levels)))) + (when ca + (set (make-local-variable 'smie-closer-alist) ca) + ;; Only needed for interactive calls to blink-matching-open. + (set (make-local-variable 'blink-matching-check-function) + #'smie-blink-matching-check) + (add-hook 'post-self-insert-hook + #'smie-blink-matching-open 'append 'local) + (set (make-local-variable 'smie-blink-matching-triggers) + (append smie-blink-matching-triggers + ;; Rather than wait for SPC to blink, try to blink as + ;; soon as we type the last char of a block ender. + (let ((closers (sort (mapcar #'cdr smie-closer-alist) + #'string-lessp)) + (triggers ()) + closer) + (while (setq closer (pop closers)) + (unless (and closers + ;; FIXME: this eliminates prefixes of other + ;; closers, but we should probably elimnate + ;; prefixes of other keywords as well. + (string-prefix-p closer (car closers))) + (push (aref closer (1- (length closer))) triggers))) + (delete-dups triggers))))))) (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 @@ (eval-when-compile (require 'cl)) -(declare-function xw-defined-colors "term/x-win" (&optional frame)) +(declare-function xw-defined-colors "term/common-win" (&optional frame)) (defvar help-xref-stack-item) @@ -1957,7 +1957,7 @@ Value is the new parameter list." (list (cons 'cursor-color fg))))))) (declare-function x-create-frame "xfns.c" (parms)) -(declare-function x-setup-function-keys "term/x-win" (frame)) +(declare-function x-setup-function-keys "term/common-win" (frame)) (defun x-create-frame-with-faces (&optional parameters) "Create and return a frame with frame parameters PARAMETERS. @@ -2578,5 +2578,4 @@ also the same size as FACE on FRAME, or fail." (provide 'faces) -;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6 ;;; 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.") "Non-nil if visited file was read-only when visited.") (make-variable-buffer-local 'buffer-file-read-only) -(defcustom temporary-file-directory - (file-name-as-directory - ;; FIXME ? Should there be Ftemporary_file_directory to do the - ;; following more robustly (cf set_local_socket in emacsclient.c). - ;; It could be used elsewhere, eg Fcall_process_region, server-socket-dir. - ;; See bug#7135. - (cond ((memq system-type '(ms-dos windows-nt)) - (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp")) - ((eq system-type 'darwin) - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") - (let ((tmp (ignore-errors (shell-command-to-string ; bug#7135 - "getconf DARWIN_USER_TEMP_DIR")))) - (and (stringp tmp) - (setq tmp (replace-regexp-in-string "\n\\'" "" tmp)) - ;; This handles "getconf: Unrecognized variable..." - (file-directory-p tmp) - tmp)) - "/tmp")) - (t - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) - "The directory for writing temporary files." - :group 'files - ;; Darwin section added 24.1, does not seem worth :version bump. - :initialize 'custom-initialize-delay - :type 'directory) - (defcustom small-temporary-file-directory (if (eq system-type 'ms-dos) (getenv "TMPDIR")) "The directory for writing small temporary files. @@ -6470,5 +6444,4 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) (define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame) -;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f ;;; 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'." (setq summary (lm-synopsis) keywords (mapcar 'intern (lm-keywords-list)) package (or package-override - (intern-soft (lm-header "package")) + (let ((str (lm-header "package"))) + (if str (intern str))) base-name) version (lm-header "version"))) (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 @@ +2010-11-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el: No need to declare `declare-function' since shr.el is for + only Emacsen that provide `libxml-parse-html-region'. + +2010-11-01 Glenn Morris <rgm@gnu.org> + + * mm-util.el (gnus-completing-read): Autoload. + (mm-read-coding-system): Simplify Emacs definition. + + * nnmail.el (gnus-activate-group): + * nnimap.el (gnutls-negotiate): + * nntp.el (netrc-parse): Fix declarations. + +2010-11-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-util.el (gnus-string-match-p): New function, that is an alias to + string-match-p in Emacs >=23. + + * gnus-msg.el (gnus-configure-posting-styles) + * nnir.el (nnir-run-gmane): Use gnus-string-match-p. + +2010-11-01 Glenn Morris <rgm@gnu.org> + + * nnir.el (declare-function): Add compat stub. + (mm-url-insert, mm-url-encode-www-form-urlencoded): Declare. + (nnir-run-gmane): Require 'mm-url. + + * mm-util.el (mm-string-to-multibyte): Simplify. + + * shr.el (declare-function): Add compat stub. + (url-cache-create-filename): Declare. + (mm-disable-multibyte, widget-convert-button): Autoload. + + * smime.el (ldap-search): Declare. + (smime-cert-by-ldap-1): Require ldap on Emacs. + + * nnimap.el: Require nnmail, and gnus-sum when compiling. + (nnimap-keepalive): Use gnus-float-time. + + * mail-source.el (nnheader-message, gnus-float-time): Autoload. + (mail-source-delete-crash-box): Use gnus-float-time. + + * gnus-dired.el (gnus-completing-read): Autoload. + + * mm-view.el (gnus-rescale-image): Autoload. + + * mm-decode.el (gnus-completing-read, gnus-blocked-images): Autoload. + + * gnus.el (gnus-sloppily-equal-method-parameters): Move defn before use. + + * sieve-manage.el: Require 'cl when compiling. + + * gnus-util.el (iswitchb-read-buffer): Declare rather than autoload. + (gnus-iswitchb-completing-read): Require iswitchb. + (gnus-select-frame-set-input-focus): Silence compiler. + +2010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-subject-trailing-was-query): Change default to t, + since I think that's what most people want. + + * nnimap.el (nnimap-request-accept-article): Erase buffer before + appending for easier debugging. + (nnimap-wait-for-connection): Take a regexp. + (nnimap-request-accept-article): Wait for the continuation line before + sending anything unless we're streaming. + + * gnus-art.el (gnus-treat-article): Only inhibit body washing, and + leave the header washing to take place. + +2010-10-31 Daniel Dehennin <daniel.dehennin@baby-gnu.org> + + * gnus-msg.el (gnus-configure-posting-styles): Permit the use of + regular expression match and replace in posting styles. + +2010-10-31 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (gnus-group-make-nnir-group,nnir-run-query): Allow searching + an entire server. + (nnir-get-active): New function. + (nnir-run-imap): Use it. + (nnir-run-gmane): Who knew, gmane search returns an article score! + + * gnus-srvr.el (gnus-server-mode-map): add binding "G" to search the + server on the current line with nnir. + +2010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-cite.el (gnus-article-foldable-buffer): Refactor out. + (gnus-article-foldable-buffer): Don't fold regions that have a ragged + left edge. + (gnus-article-foldable-buffer): Skip past the prefix when determining + raggedness. + + * gnus-sum.el (gnus-summary-show-article): Add `C-u C-u g' for showing + the raw article, and change `C-u g' to show the article without doing + treatments. + + * gnus-art.el (gnus-mime-display-alternative): Actually pass the type + on to `gnus-treat-article'. + (gnus-inhibit-article-treatments): New variable. + + * gnus.el: Autoload gnus-article-fill-cited-long-lines. + + * gnus-art.el (gnus-treatment-function-alist): Have + gnus-treat-fill-long-lines point to gnus-article-fill-cited-long-lines. + (gnus-treat-fill-long-lines): Change default to fill all text/plain + sections. + + * gnus-cite.el (gnus-article-fill-cited-article): Remove unused `force' + parameter. + (gnus-article-fill-cited-long-lines): New function. + (gnus-article-fill-cited-article): Allow filling only long sections. + + * shr.el (shr-find-fill-point): Don't break lines between punctuation + and non-punctuation (like after the apostrophe in "'We"). + + * gnus-sum.el (gnus-summary-select-article): Make sure + gnus-original-article-buffer is alive. + + * nndoc.el (nndoc-dissect-buffer): Reverse the order of the articles to + reflect the order they're in in the digest. + + * gnus.el (gnus-group-startup-message): Move point to the start of the + buffer. + + * nnimap.el (nnimap-capability): New function. + (nnimap-open-connection): Only send AUTHENTICATE PLAIN if LOGINDISABLED + is set. + +2010-10-31 David Engster <dengste@eml.cc> + + * nnmairix.el (nnmairix-get-valid-servers): Return list of strings to + conform with changes to gnus-completing-read. + +2010-10-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-img): Output "*" instead of "[img]". + +2010-10-30 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el move defvar, defcustom around to keep file organized and keep + byte-compiler quiet. + (nnir-read-parms): accept search-engine as arg. + (nnir-run-query): pass search-engine as arg. + (nnir-search-engine): remove. + +2010-10-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-generic): The text nodes should be text, not :text. + + * nnir.el (nnir-search-engine): Ressurect variable, since it's used + later in the file. + +2010-10-30 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el: general clean up. allow searching with multiple + engines. allow separate extra-parameters for each engine. batch queries + when possible. + (nnir-imap-default-search-key,nnir-method-default-engines): add + customize interface. + (nnir-run-gmane): new engine. + (nnir-engines): use it. qualify all prompts with engine name. + (nnir-search-engine): remove global variable. + (nnir-run-hyrex): restore for now. + (nnir-extra-parms,nnir-search-history): new variables. + (gnus-group-make-nnir-group): use them. + (nnir-group-server): remove in favor of gnus-group-server. + (nnir-request-group): avoid searching twice. + (nnir-sort-groups-by-server): new function. + +2010-10-30 Julien Danjou <julien@danjou.info> + + * gnus-group.el: Remove gnus-group-fetch-control. + + * gnus-start.el (gnus-find-new-newsgroups): Remove + gnus-check-first-time-used. + + * gnus.el: Remove gnus-backup-default-subscribed-newsgroups. + +2010-10-30 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change) + + * nnimap.el (nnimap-update-info): Allow 'ticked and other flags to be + set on groups that don't have \* permanentflags. + +2010-10-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-span): Drop colorisation of regions since we don't + control the background color. + (shr-tag-img): Ignore very small web bug type images. + (shr-put-image): Add help-echo alt texts to the images. + (shr-tag-video): Show the video poster image. + +2010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-table-depth): New variable. + (shr-tag-table-1): Only insert the images after the top-level table. + + * nnimap.el (nnimap-split-incoming-mail): Fix typo. + + * gnus-util.el (gnus-list-memq-of-list): New function. + + * nnimap.el (nnimap-split-incoming-mail): Note that the INBOX has been + selected. + (nnimap-unsplittable-articles): New slot. + (nnimap-new-articles): Use it. + +2010-10-29 Stephen Berman <stephen.berman@gmx.net> (tiny change) + + * gnus-group.el (gnus-group-get-new-news-this-group): Don't have point + move to the previous line on `M-g'. + +2010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-msg.el (gnus-inews-do-gcc): Don't have the backends do the slow + *-request-group, which seems unnecessary. + + * nnimap.el (nnimap-quote-specials): Function copied over from + imap.el. + (nnimap-open-connection): Use AUTHENTICATE PLAIN on servers that say + they support that. Suggested by Tom Regner. + +2010-10-29 Julien Danjou <julien@danjou.info> + + * gnus-sum.el (gnus-summary-delete-marked-as-read): Remove obsolete + defalias. + (gnus-summary-delete-marked-with): Remove obsolete defalias. + + * gnus.el: Remove `gnus-nntp-service' variable. + (gnus-secondary-servers): Make obsolete. + (gnus-nntp-server): Make obsolete. + + * gnus-start.el (gnus-1): Remove x-splash calls. + + * gnus-ems.el (gnus-x-splash): Remove. + + * gnus.el (gnus-group-startup-message): Simplify/update code. + + * gnus-group.el (gnus-group-make-tool-bar): Check for display graphic + capability before doing anything. + (gnus-group-insert-group-line): Remove useless + gnus-group-remove-excess-properties. + +2010-10-29 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-goto-part): Work for article narrowed by ^L. + +2010-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-summary-rescan-group): Try to restore the window + config after reselecting. + +2010-10-28 Julien Danjou <julien@danjou.info> + + * shr.el (shr-put-image): Use point even if only inserting text. + (shr-put-image): Save excursion when inserting alt text on non-graphic + display, so the behaviour is the same when we are on a graphic display. + + * nnir.el (nnir-run-swish-e): Remove hyrex support. + 2010-10-28 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-article-jump-to-part): Error on no part; fix prompt. @@ -429,12 +690,12 @@ * nnimap.el (gnutls-negotiate): Silence the byte compiler. - * gnus-art.el, gnus-cache.el, gnus-fun.el, gnus-group.el, - gnus-picon.el, gnus-spec.el, gnus-sum.el, gnus-util.el, gnus.el, - mail-source.el, message.el, mm-bodies.el, mm-decode.el, mm-extern.el, - mm-util.el, mm-view.el, mml-smime.el, mml.el, mml1991.el, mml2015.el, - nnfolder.el, nnheader.el, nnmail.el, nnmaildir.el, nnrss.el, nntp.el, - rfc1843.el, sieve-manage.el, smime.el, spam.el: + * gnus-art.el, gnus-cache.el, gnus-fun.el, gnus-group.el: + * gnus-picon.el, gnus-spec.el, gnus-sum.el, gnus-util.el, gnus.el: + * mail-source.el, message.el, mm-bodies.el, mm-decode.el, mm-extern.el: + * mm-util.el, mm-view.el, mml-smime.el, mml.el, mml1991.el, mml2015.el: + * nnfolder.el, nnheader.el, nnmail.el, nnmaildir.el, nnrss.el, nntp.el: + * rfc1843.el, sieve-manage.el, smime.el, spam.el: Fix comment for declare-function. 2010-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -1334,7 +1595,7 @@ 2010-09-27 David Engster <dengste@eml.cc> - * nnmairix.el: (nnmairix-replace-group-and-numbers): Deal with NOV as + * nnmairix.el (nnmairix-replace-group-and-numbers): Deal with NOV as well as HEADERS. (nnmairix-retrieve-headers): Provide new argument for the above. @@ -1712,7 +1973,7 @@ (nnimap-make-process-buffer): Store all the process buffers. (nnimap-keepalive): New function. - * starttls.el: (starttls-open-stream): Add autoload cookie. + * starttls.el (starttls-open-stream): Add autoload cookie. 2010-09-24 Michael Welsh Duggan <md5i@md5i.com> (tiny change) 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'." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(defcustom gnus-treat-fill-long-lines nil +(defcustom gnus-treat-fill-long-lines '(typep "text/plain") "Fill long lines. Valid values are nil, t, `head', `first', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles'." @@ -1664,7 +1664,7 @@ regexp." (gnus-treat-highlight-signature gnus-article-highlight-signature) (gnus-treat-buttonize gnus-article-add-buttons) (gnus-treat-fill-article gnus-article-fill-cited-article) - (gnus-treat-fill-long-lines gnus-article-fill-long-lines) + (gnus-treat-fill-long-lines gnus-article-fill-cited-long-lines) (gnus-treat-strip-cr gnus-article-remove-cr) (gnus-treat-unsplit-urls gnus-article-unsplit-urls) (gnus-treat-date-ut gnus-article-date-ut) @@ -5561,35 +5561,41 @@ all parts." (defun gnus-article-goto-part (n) "Go to MIME part N." - (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) - part handle end next handles) - (when start - (goto-char start) - (if (setq handle (get-text-property start 'gnus-data)) - start - ;; Go to the displayed subpart, assuming this is multipart/alternative. - (setq part start - end (point-at-eol)) - (while (and (not handle) - part - (< part end) - (setq next (text-property-not-all part end - 'gnus-data nil))) - (setq part next - handle (get-text-property part 'gnus-data)) - (push (cons handle part) handles) - (unless (mm-handle-displayed-p handle) - (setq handle nil - part (text-property-any part end 'gnus-data nil)))) - (unless handle - ;; No subpart is displayed, so we find preferred one. - (setq part - (cdr (assq (mm-preferred-alternative - (nreverse (mapcar 'car handles))) - handles)))) - (if part - (goto-char (1+ part)) - start))))) + (when gnus-break-pages + (widen)) + (prog1 + (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) + part handle end next handles) + (when start + (goto-char start) + (if (setq handle (get-text-property start 'gnus-data)) + start + ;; Go to the displayed subpart, assuming this is + ;; multipart/alternative. + (setq part start + end (point-at-eol)) + (while (and (not handle) + part + (< part end) + (setq next (text-property-not-all part end + 'gnus-data nil))) + (setq part next + handle (get-text-property part 'gnus-data)) + (push (cons handle part) handles) + (unless (mm-handle-displayed-p handle) + (setq handle nil + part (text-property-any part end 'gnus-data nil)))) + (unless handle + ;; No subpart is displayed, so we find preferred one. + (setq part + (cdr (assq (mm-preferred-alternative + (nreverse (mapcar 'car handles))) + handles)))) + (if part + (goto-char (1+ part)) + start)))) + (when gnus-break-pages + (gnus-narrow-to-page)))) (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name @@ -5698,7 +5704,7 @@ all parts." (save-restriction (article-goto-body) (narrow-to-region (point) (point-max)) - (gnus-treat-article nil 1 1) + (gnus-treat-article nil 1 1 "text/plain") (widen))) (unless ihandles ;; Highlight the headers. @@ -5986,7 +5992,7 @@ If displaying \"text/html\" is discouraged \(see (gnus-treat-article nil (length gnus-article-mime-handle-alist) (gnus-article-mime-total-parts) - (mm-handle-media-type handle)))))) + (mm-handle-media-type preferred)))))) (goto-char (point-max)) (setcdr begend (point-marker))))) (when ibegend @@ -8249,6 +8255,8 @@ For example: ;;; Treatment top-level handling. ;;; +(defvar gnus-inhibit-article-treatments nil) + (defun gnus-treat-article (condition &optional part-number total-parts type) (let ((length (- (point-max) (point-min))) (alist gnus-treatment-function-alist) @@ -8271,6 +8279,8 @@ For example: (symbol-value (car elem)))) (when (and (or (consp val) treated-type) + (or (not gnus-inhibit-article-treatments) + (eq condition 'head)) (gnus-treat-predicate val) (or (not (get (car elem) 'highlight)) 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 (setq m (cdr m)))) marks)))) -(defun gnus-article-fill-cited-article (&optional force width) +(defun gnus-article-fill-cited-long-lines () + (gnus-article-fill-cited-article nil t)) + +(defun gnus-article-fill-cited-article (&optional width long-lines) "Do word wrapping in the current article. -If WIDTH (the numerical prefix), use that text width when filling." - (interactive (list t current-prefix-arg)) +If WIDTH (the numerical prefix), use that text width when +filling. If LONG-LINES, only fill sections that have lines +longer than the frame width." + (interactive "P") (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) @@ -535,8 +540,12 @@ If WIDTH (the numerical prefix), use that text width when filling." (fill-prefix (if (string= (cdar marks) "") "" (concat (cdar marks) " "))) + (do-fill (not long-lines)) use-hard-newlines) - (fill-region (point-min) (point-max))) + (unless do-fill + (setq do-fill (gnus-article-foldable-buffer (cdar marks)))) + (when do-fill + (fill-region (point-min) (point-max)))) (set-marker (caar marks) nil) (setq marks (cdr marks))) (when marks @@ -548,6 +557,28 @@ If WIDTH (the numerical prefix), use that text width when filling." gnus-cite-loose-attribution-alist nil gnus-cite-article nil))))) +(defun gnus-article-foldable-buffer (prefix) + (let ((do-fill nil) + columns) + (goto-char (point-min)) + (while (not (eobp)) + (forward-char (length prefix)) + (skip-chars-forward " \t") + (unless (eolp) + (let ((elem (assq (current-column) columns))) + (unless elem + (setq elem (cons (current-column) 0)) + (push elem columns)) + (setcdr elem (1+ (cdr elem))))) + (end-of-line) + (when (> (current-column) (frame-width)) + (setq do-fill t)) + (forward-line 1)) + (and do-fill + ;; We know know that there are long lines here, but does this look + ;; like code? Check for ragged edges on the left. + (< (length columns) 3)))) + (defun gnus-article-natural-long-line-p () "Return true if the current line is long, and it's natural text." (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 @@ ;;; gnus-dired.el --- utility functions where gnus and dired meet -;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Authors: Benjamin Rutt <brutt@bloomington.in.us>, ;; Shenghuo Zhu <zsh@cs.rochester.edu> @@ -122,6 +122,8 @@ See `mail-user-agent' for more information." (push (buffer-name buffer) buffers)))) (nreverse buffers)))) +(autoload 'gnus-completing-read "gnus-util") + ;; Method to attach files to a mail composition. (defun gnus-dired-attach (files-to-attach) "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 @@ (autoload 'gnus-alive-p "gnus-util") (autoload 'mm-disable-multibyte "mm-util") -(defun gnus-x-splash () - "Show a splash screen using a pixmap in the current buffer." - (interactive) - (unless window-system - (error "`gnus-x-splash' requires running on the window system")) - (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p) - (interactive-p)) - "*gnus-x-splash*" - gnus-group-buffer))) - (let ((inhibit-read-only t) - (file (nnheader-find-etc-directory "images/gnus/x-splash" t)) - pixmap fcw fch width height fringes sbars left yoffset top ls) - (erase-buffer) - (sit-for 0) ;; Necessary for measuring the window size correctly. - (when (and file - (ignore-errors - (let ((coding-system-for-read 'raw-text)) - (with-temp-buffer - (mm-disable-multibyte) - (insert-file-contents file) - (goto-char (point-min)) - (setq pixmap (read (current-buffer))))))) - (setq fcw (float (frame-char-width)) - fch (float (frame-char-height)) - width (/ (car pixmap) fcw) - height (/ (cadr pixmap) fch) - fringes (if (fboundp 'window-fringes) - (eval '(window-fringes)) - '(10 11 nil)) - sbars (frame-parameter nil 'vertical-scroll-bars)) - (cond ((eq sbars 'right) - (setq sbars - (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14) - fcw)))) - (sbars - (setq sbars - (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14) - fcw) - 0))) - (t - (setq sbars '(0 . 0)))) - (setq left (- (* (round (/ (1- (/ (+ (window-width) - (car sbars) (cdr sbars) - (/ (+ (or (car fringes) 0) - (or (cadr fringes) 0)) - fcw)) - width)) - 2)) - width) - (car sbars) - (/ (or (car fringes) 0) fcw)) - yoffset (cadr (window-edges)) - top (max 0 (- (* (max (if (and (boundp 'tool-bar-mode) - tool-bar-mode - (not (featurep 'gtk)) - (eq (frame-first-window) - (selected-window))) - 1 0) - (round (/ (1- (/ (+ (1- (window-height)) - (* 2 yoffset)) - height)) - 2))) - height) - yoffset)) - ls (/ (or line-spacing 0) fch) - height (max 0 (- height ls))) - (cond ((>= (- top ls) 1) - (insert - (propertize - " " - 'display `(space :width 0 :ascent 100)) - "\n" - (propertize - " " - 'display `(space :width 0 :height ,(- top ls 1) :ascent 100)) - "\n")) - ((> (- top ls) 0) - (insert - (propertize - " " - 'display `(space :width 0 :height ,(- top ls) :ascent 100)) - "\n"))) - (if (and (> width 0) (> left 0)) - (insert (propertize - " " - 'display `(space :width ,left :height ,height :ascent 0))) - (setq width (+ width left))) - (when (> width 0) - (insert (propertize - " " - 'display `(space :width ,width :height ,height :ascent 0) - 'face `(gnus-splash :stipple ,pixmap)))) - (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min))) - (redraw-frame (selected-frame)) - (sit-for 0)))) - ;;; Image functions. (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.") "e" gnus-score-edit-all-score) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "C" gnus-group-fetch-control "d" gnus-group-describe-group "v" gnus-version) @@ -807,10 +806,6 @@ simple manner.") ["Describe" gnus-group-describe-group :active (gnus-group-group-name) ,@(if (featurep 'xemacs) nil '(:help "Display description of the current group"))] - ["Fetch control message" gnus-group-fetch-control - :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Display the archived control message for the current group"))] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) ["Expire articles" gnus-group-expire-articles @@ -1090,8 +1085,7 @@ When FORCE, rebuild the tool bar." (when (and (not (featurep 'xemacs)) (boundp 'tool-bar-mode) tool-bar-mode - ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode). - ;; Why? --rsteib + (display-graphic-p) (or (not gnus-group-tool-bar-map) force)) (let* ((load-path (gmm-image-load-path-for-library "gnus" @@ -1607,9 +1601,7 @@ if it is a string, only list groups matching REGEXP." (when (inline (gnus-visual-p 'group-highlight 'highlight)) (gnus-group-highlight-line gnus-tmp-group beg end)) (gnus-run-hooks 'gnus-group-update-hook) - (forward-line) - ;; Allow XEmacs to remove front-sticky text properties. - (gnus-group-remove-excess-properties))) + (forward-line))) (defun gnus-group-update-eval-form (group list) "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." (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) (beg (unless n - (point))) + (point-marker))) group method (gnus-inhibit-demon t) ;; Binding this variable will inhibit multiple fetchings @@ -4025,32 +4017,6 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (gnus-group-position-point) ret)) -(defun gnus-group-fetch-control (group) - "Fetch the archived control messages for the current group. -If given a prefix argument, prompt for a group." - (interactive - (list (or (when current-prefix-arg - (gnus-group-completing-read)) - (gnus-group-group-name) - gnus-newsgroup-name))) - (unless group - (error "No group name given")) - (let ((name (gnus-group-real-name group)) - hierarchy) - (when (string-match "\\(^[^\\.]+\\)\\..*" name) - (setq hierarchy (match-string 1 name)) - (if gnus-group-fetch-control-use-browse-url - (browse-url (concat "ftp://ftp.isc.org/usenet/control/" - hierarchy "/" name ".gz")) - (let ((enable-local-variables nil)) - (gnus-group-read-ephemeral-group - group - `(nndoc ,group (nndoc-address - ,(find-file-noselect - (concat "/ftp@ftp.isc.org:/usenet/control/" - hierarchy "/" name ".gz"))) - (nndoc-article-type mbox)) t nil nil)))))) - (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (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." ;; Stream is already opened. nil ;; Open NNTP server. - (unless gnus-nntp-service - (setq gnus-nntp-server nil)) (when confirm ;; Read server name with completion. (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." (unless (gnus-check-server method) (error "Can't open server %s" (if (stringp method) method (car method)))) - (unless (gnus-request-group group nil method) + (unless (gnus-request-group group t method) (gnus-request-create-group group method)) (setq mml-externalize-attachments (if (stringp gnus-gcc-externalize-attachments) @@ -1891,7 +1891,11 @@ this is a reply." (setq v (cond ((stringp value) - value) + (if (and (stringp match) + (gnus-string-match-p "\\\\[&[:digit:]]" value) + (match-beginning 1)) + (gnus-match-substitute-replacement value nil nil group) + value)) ((or (symbolp value) (functionp value)) (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 @@ (require 'gnus-int) (require 'gnus-range) +(autoload 'gnus-group-make-nnir-group "nnir") + (defcustom gnus-server-mode-hook nil "Hook run in `gnus-server-mode' buffers." :group 'gnus-server @@ -165,6 +167,8 @@ If nil, a faster, but more primitive, buffer is used instead." "g" gnus-server-regenerate-server + "G" gnus-group-make-nnir-group + "z" gnus-server-compact-server "\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." (if gnus-agent (gnus-agentize)) - (when gnus-simple-splash - (setq gnus-simple-splash nil) - (cond - ((featurep 'xemacs) - (gnus-xmas-splash)) - (window-system - (gnus-x-splash)))) - (let ((level (and (numberp arg) (> arg 0) arg)) did-connect) (unwind-protect @@ -1108,53 +1100,52 @@ for new groups, and subscribe the new groups as zombies." 'gnus-subscribe-zombies) t) (t gnus-check-new-newsgroups)))) - (unless (gnus-check-first-time-used) - (if (or (consp check) - (eq check 'ask-server)) - ;; Ask the server for new groups. - (gnus-ask-server-for-new-groups) - ;; Go through the active hashtb and look for new groups. - (let ((groups 0) - group new-newsgroups) - (gnus-message 5 "Looking for new newsgroups...") - (unless gnus-have-read-active-file - (gnus-read-active-file)) - (setq gnus-newsrc-last-checked-date (message-make-date)) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go though every newsgroup in `gnus-active-hashtb' and compare - ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. - (mapatoms - (lambda (sym) - (if (or (null (setq group (symbol-name sym))) - (not (boundp sym)) - (null (symbol-value sym)) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) - (gnus-call-subscribe-functions - gnus-subscribe-newsgroup-method group))))))) - gnus-active-hashtb) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups)) - (if (> groups 0) - (gnus-message 5 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has")) - (gnus-message 5 "No new newsgroups."))))))) + (if (or (consp check) + (eq check 'ask-server)) + ;; Ask the server for new groups. + (gnus-ask-server-for-new-groups) + ;; Go through the active hashtb and look for new groups. + (let ((groups 0) + group new-newsgroups) + (gnus-message 5 "Looking for new newsgroups...") + (unless gnus-have-read-active-file + (gnus-read-active-file)) + (setq gnus-newsrc-last-checked-date (message-make-date)) + (unless gnus-killed-hashtb + (gnus-make-hashtable-from-killed)) + ;; Go though every newsgroup in `gnus-active-hashtb' and compare + ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. + (mapatoms + (lambda (sym) + (if (or (null (setq group (symbol-name sym))) + (not (boundp sym)) + (null (symbol-value sym)) + (gnus-gethash group gnus-killed-hashtb) + (gnus-gethash group gnus-newsrc-hashtb)) + () + (let ((do-sub (gnus-matches-options-n group))) + (cond + ((eq do-sub 'subscribe) + (setq groups (1+ groups)) + (gnus-sethash group group gnus-killed-hashtb) + (gnus-call-subscribe-functions + gnus-subscribe-options-newsgroup-method group)) + ((eq do-sub 'ignore) + nil) + (t + (setq groups (1+ groups)) + (gnus-sethash group group gnus-killed-hashtb) + (if gnus-subscribe-hierarchical-interactive + (push group new-newsgroups) + (gnus-call-subscribe-functions + gnus-subscribe-newsgroup-method group))))))) + gnus-active-hashtb) + (when new-newsgroups + (gnus-subscribe-hierarchical-interactive new-newsgroups)) + (if (> groups 0) + (gnus-message 5 "%d new newsgroup%s arrived." + groups (if (> groups 1) "s have" " has")) + (gnus-message 5 "No new newsgroups.")))))) (defun gnus-matches-options-n (group) ;; Returns `subscribe' if the group is to be unconditionally @@ -1254,53 +1245,6 @@ for new groups, and subscribe the new groups as zombies." (setq gnus-newsrc-last-checked-date new-date)) got-new)) -(defun gnus-check-first-time-used () - (catch 'ended - ;; First check if any of the following files exist. If they do, - ;; it's not the first time the user has used Gnus. - (dolist (file (list (concat gnus-current-startup-file ".el") - (concat gnus-current-startup-file ".eld") - (concat gnus-startup-file ".el") - (concat gnus-startup-file ".eld"))) - (when (file-exists-p file) - (throw 'ended nil))) - (gnus-message 6 "First time user; subscribing you to default groups") - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - (setq gnus-newsrc-last-checked-date (message-make-date)) - ;; Subscribe to the default newsgroups. - (let ((groups (or gnus-default-subscribed-newsgroups - gnus-backup-default-subscribed-newsgroups)) - group) - (if (eq groups t) - ;; If t, we subscribe (or not) all groups as if they were new. - (mapatoms - (lambda (sym) - (when (setq group (symbol-name sym)) - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (push group gnus-killed-list)))))) - gnus-active-hashtb) - (dolist (group groups) - ;; Only subscribe the default groups that are activated. - (when (gnus-active group) - (gnus-group-change-level - group gnus-level-default-subscribed gnus-level-killed))) - (with-current-buffer gnus-group-buffer - ;; Don't error if the group already exists. This happens when a - ;; first-time user types 'F'. -- didier - (gnus-group-make-help-group t)) - (when gnus-novice-user - (gnus-message 7 "`A k' to list killed groups")))))) - (defun gnus-subscribe-group (group &optional previous method) "Subscribe GROUP and put it after PREVIOUS." (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." "v" gnus-version "d" gnus-summary-describe-group "h" gnus-summary-describe-briefly - "i" gnus-info-find-node - "C" gnus-group-fetch-control) + "i" gnus-info-find-node) (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) "e" gnus-summary-expire-articles @@ -2747,9 +2746,6 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Original sort" gnus-summary-sort-by-original t]) ("Help" ["Describe group" gnus-summary-describe-group t] - ["Fetch control message" gnus-group-fetch-control - ,@(if (featurep 'xemacs) nil - '(:help "Display the archived control message for the current group"))] ["Read manual" gnus-info-find-node t]) ("Modes" ["Pick and read" gnus-pick-mode t] @@ -7033,7 +7029,11 @@ The prefix argument ALL means to select all articles." (defun gnus-summary-rescan-group (&optional all) "Exit the newsgroup, ask for new articles, and select the newsgroup." (interactive "P") - (gnus-summary-reselect-current-group all t)) + (let ((config gnus-current-window-configuration)) + (gnus-summary-reselect-current-group all t) + (gnus-configure-windows config) + (when (eq config 'article) + (gnus-summary-select-article)))) (defun gnus-summary-update-info (&optional non-destructive) (save-excursion @@ -7596,6 +7596,7 @@ be displayed." (not (get-buffer gnus-original-article-buffer)))) (and (not gnus-single-article-buffer) (or (null gnus-current-article) + (not (get-buffer gnus-original-article-buffer)) (not (eq gnus-current-article article)))) force) ;; The requested article is different from the current article. @@ -8299,10 +8300,6 @@ articles that are younger than AGE days." (gnus-summary-limit articles)) (gnus-summary-position-point)) -(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) -(make-obsolete - 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4") - (defun gnus-summary-limit-to-unread (&optional all) "Limit the summary buffer to articles that are not marked as read. If ALL is non-nil, limit strictly to unread articles." @@ -8393,10 +8390,6 @@ If UNREPLIED (the prefix), limit to unreplied articles." (gnus-summary-limit gnus-newsgroup-replied)) (gnus-summary-position-point)) -(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) -(make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exclude-marks "Emacs 20.4") - (defun gnus-summary-limit-exclude-marks (marks &optional reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). If REVERSE, limit the summary buffer to articles that are marked @@ -9400,9 +9393,10 @@ article currently." If ARG (the prefix) is a number, show the article with the charset defined in `gnus-summary-show-article-charset-alist', or the charset input. -If ARG (the prefix) is non-nil and not a number, show the raw article -without any article massaging functions being run. Normally, the key -strokes are `C-u g'." +If ARG (the prefix) is non-nil and not a number, show the article, +but without running any of the article treatment functions +article. Normally, the keystroke is `C-u g'. When using `C-u +C-u g', show the raw article." (interactive "P") (cond ((numberp arg) @@ -9444,7 +9438,8 @@ strokes are `C-u g'." ((not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force)) - (t + ((equal arg '(16)) + ;; C-u C-u g ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) @@ -9462,6 +9457,9 @@ strokes are `C-u g'." ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) (setq gnus-article-mime-handles nil))) + (gnus-summary-select-article nil 'force))) + (t + (let ((gnus-inhibit-article-treatments t)) (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (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', initial-input history def)) -(autoload 'iswitchb-read-buffer "iswitchb") +(declare-function iswitchb-read-buffer "iswitchb" + (prompt &optional default require-match start matches-set)) +(defvar iswitchb-temp-buflist) + (defun gnus-iswitchb-completing-read (prompt collection &optional require-match initial-input history def) "`iswitchb' based completing-read function." + (require 'iswitchb) (let ((iswitchb-make-buflist-hook (lambda () (setq iswitchb-temp-buflist @@ -1667,11 +1671,11 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (nreverse filtered-choices)))))) (unwind-protect (progn - (when (not iswitchb-mode) - (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) + (or iswitchb-mode + (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) (iswitchb-read-buffer prompt def require-match)) - (when (not iswitchb-mode) - (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) + (or iswitchb-mode + (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) (defun gnus-graphic-display-p () (if (featurep 'xemacs) @@ -1758,14 +1762,16 @@ CHOICE is a list of the choice char and help message at IDX." (kill-buffer buf)) tchar)) -(if (fboundp 'select-frame-set-input-focus) +(if (featurep 'emacs) (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus) - ;; XEmacs 21.4, SXEmacs - (defun gnus-select-frame-set-input-focus (frame) - "Select FRAME, raise it, and set input focus, if possible." - (raise-frame frame) - (select-frame frame) - (focus-frame frame))) + (if (fboundp 'select-frame-set-input-focus) + (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus) + ;; XEmacs 21.4, SXEmacs + (defun gnus-select-frame-set-input-focus (frame) + "Select FRAME, raise it, and set input focus, if possible." + (raise-frame frame) + (select-frame frame) + (focus-frame frame)))) (defun gnus-frame-or-window-display-name (object) "Given a frame or window, return the associated display name. @@ -1974,6 +1980,44 @@ Sizes are in pixels." image))) image))) +(defun gnus-list-memq-of-list (elements list) + "Return non-nil if any of the members of ELEMENTS are in LIST." + (let ((found nil)) + (dolist (elem elements) + (setq found (or found + (memq elem list)))) + found)) + +(eval-and-compile + (cond + ((fboundp 'match-substitute-replacement) + (defalias 'gnus-match-substitute-replacement 'match-substitute-replacement)) + (t + (defun gnus-match-substitute-replacement (replacement &optional fixedcase literal string subexp) + "Return REPLACEMENT as it will be inserted by `replace-match'. +In other words, all back-references in the form `\\&' and `\\N' +are substituted with actual strings matched by the last search. +Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same +meaning as for `replace-match'. + +This is the definition of match-substitute-replacement in subr.el from GNU Emacs." + (let ((match (match-string 0 string))) + (save-match-data + (set-match-data (mapcar (lambda (x) + (if (numberp x) + (- x (match-beginning 0)) + x)) + (match-data t))) + (replace-match replacement fixedcase literal match subexp))))))) + +(if (fboundp 'string-match-p) + (defalias 'gnus-string-match-p 'string-match-p) + (defsubst gnus-string-match-p (regexp string &optional start) + "\ +Same as `string-match' except this function does not change the match data." + (save-match-data + (string-match regexp string start)))) + (provide 'gnus-util) ;;; 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 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, +;; 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -308,9 +308,6 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) -(unless (fboundp 'gnus-group-remove-excess-properties) - (defalias 'gnus-group-remove-excess-properties 'ignore)) - (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) @@ -353,7 +350,6 @@ be set in `.emacs' instead." (list str)) line))) (defalias 'gnus-mode-line-buffer-identification 'identity)) - (defalias 'gnus-characterp 'numberp) (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) (defalias 'gnus-key-press-event-p 'numberp) @@ -921,7 +917,8 @@ be set in `.emacs' instead." ;;; Gnus buffers ;;; -(defvar gnus-buffers nil) +(defvar gnus-buffers nil + "List of buffers handled by Gnus.") (defun gnus-get-buffer-create (name) "Do the same as `get-buffer-create', but store the created buffer." @@ -953,7 +950,8 @@ be set in `.emacs' instead." ;;; Splash screen. -(defvar gnus-group-buffer "*Group*") +(defvar gnus-group-buffer "*Group*" + "Name of the Gnus group buffer.") (defface gnus-splash '((((class color) @@ -992,8 +990,6 @@ be set in `.emacs' instead." (while (search-forward "\t" nil t) (replace-match " " t t)))))) -(defvar gnus-simple-splash nil) - ;;(format "%02x%02x%02x" 114 66 20) "724214" (defvar gnus-logo-color-alist @@ -1033,50 +1029,47 @@ be set in `.emacs' instead." "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) - (cond - ((and - (fboundp 'find-image) - (display-graphic-p) - ;; Make sure the library defining `image-load-path' is loaded - ;; (`find-image' is autoloaded) (and discard the result). Else, we may - ;; get "defvar ignored because image-load-path is let-bound" when calling - ;; `find-image' below. - (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) - (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) - (image-load-path (cond (data-directory - (list data-directory)) - ((boundp 'image-load-path) - (symbol-value 'image-load-path)) - (t load-path))) - (image (find-image - `((:type xpm :file "gnus.xpm" - :color-symbols - (("thing" . ,(car gnus-logo-colors)) - ("shadow" . ,(cadr gnus-logo-colors)) - ("oort" . "#eeeeee") - ("background" . ,(face-background 'default)))) - (:type svg :file "gnus.svg") - (:type png :file "gnus.png") - (:type pbm :file "gnus.pbm" - ;; Account for the pbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)) - (:type xbm :file "gnus.xbm" - ;; Account for the xbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)))))) - (when image - (let ((size (image-size image))) - (insert-char ?\n (max 0 (round (- (window-height) - (or y (cdr size)) 1) 2))) - (insert-char ?\ (max 0 (round (- (window-width) - (or x (car size))) 2))) - (insert-image image)) - (setq gnus-simple-splash nil) - t)))) - (t + (unless (and + (fboundp 'find-image) + (display-graphic-p) + ;; Make sure the library defining `image-load-path' is + ;; loaded (`find-image' is autoloaded) (and discard the + ;; result). Else, we may get "defvar ignored because + ;; image-load-path is let-bound" when calling `find-image' + ;; below. + (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) + (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) + (image-load-path (cond (data-directory + (list data-directory)) + ((boundp 'image-load-path) + (symbol-value 'image-load-path)) + (t load-path))) + (image (find-image + `((:type xpm :file "gnus.xpm" + :color-symbols + (("thing" . ,(car gnus-logo-colors)) + ("shadow" . ,(cadr gnus-logo-colors)))) + (:type svg :file "gnus.svg") + (:type png :file "gnus.png") + (:type pbm :file "gnus.pbm" + ;; Account for the pbm's background. + :background ,(face-foreground 'gnus-splash) + :foreground ,(face-background 'default)) + (:type xbm :file "gnus.xbm" + ;; Account for the xbm's background. + :background ,(face-foreground 'gnus-splash) + :foreground ,(face-background 'default)))))) + (when image + (let ((size (image-size image))) + (insert-char ?\n (max 0 (round (- (window-height) + (or y (cdr size)) 1) 2))) + (insert-char ?\ (max 0 (round (- (window-width) + (or x (car size))) 2))) + (insert-image image)) + (goto-char (point-min)) + t))) (insert - (format " %s + (format " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -1095,8 +1088,7 @@ be set in `.emacs' instead." _ __ -" - "")) +")) ;; And then hack it. (gnus-indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 46)) 0) 2)) @@ -1108,10 +1100,9 @@ be set in `.emacs' instead." (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Fontify some. (put-text-property (point-min) (point-max) 'face 'gnus-splash) - (setq gnus-simple-splash t))) - (goto-char (point-min)) - (setq mode-line-buffer-identification (concat " " gnus-version)) - (set-buffer-modified-p t)) + (goto-char (point-min)) + (setq mode-line-buffer-identification (concat " " gnus-version)) + (set-buffer-modified-p t))) (eval-when (load) (let ((command (format "%s" this-command))) @@ -1267,15 +1258,6 @@ by the user. If you want to change servers, you should use `gnus-select-method'. See the documentation to that variable.") -;; Don't touch this variable. -(defvar gnus-nntp-service "nntp" - "NNTP service name (\"nntp\" or 119). -This is an obsolete variable, which is scarcely used. If you use an -nntp server for your newsgroup and want to change the port number -used to 899, you would say something along these lines: - - (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") - (defcustom gnus-nntpserver-file "/etc/nntpserver" "A file with only the name of the nntp server in it." :group 'gnus-files @@ -1299,20 +1281,11 @@ Check the NNTPSERVER environment variable and the ;;;###autoload (custom-autoload 'gnus-select-method "gnus")) (defcustom gnus-select-method - (condition-case nil - (nconc - (list 'nntp (or (condition-case nil - (gnus-getenv-nntpserver) - (error nil)) - (when (and gnus-default-nntp-server - (not (string= gnus-default-nntp-server ""))) - gnus-default-nntp-server) - "news")) - (if (or (null gnus-nntp-service) - (equal gnus-nntp-service "nntp")) - nil - (list gnus-nntp-service))) - (error nil)) + (list 'nntp (or (gnus-getenv-nntpserver) + (when (and gnus-default-nntp-server + (not (string= gnus-default-nntp-server ""))) + gnus-default-nntp-server) + "news")) "Default method for selecting a newsgroup. This variable should be a list, where the first element is how the news 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 non-numeric prefix - `C-u M-x gnus', in short." :group 'gnus-server :type '(repeat string)) +(make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1") (defcustom gnus-nntp-server nil - "*The name of the host running the NNTP server. -This variable is semi-obsolete. Use the `gnus-select-method' -variable instead." + "The name of the host running the NNTP server." :group 'gnus-server :type '(choice (const :tag "disable" nil) string)) +(make-obsolete-variable 'gnus-nntp-server 'gnus-select-method "24.1") (defcustom gnus-secondary-select-methods nil "A list of secondary methods that will be used for reading news. @@ -1418,11 +1391,6 @@ you could set this variable: :group 'gnus-server :type '(repeat gnus-select-method)) -(defvar gnus-backup-default-subscribed-newsgroups - '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") - "Default default new newsgroups the first time Gnus is run. -Should be set in paths.el, and shouldn't be touched by the user.") - (defcustom gnus-local-domain nil "Local domain name without a host name. The 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." (nnweb "refer" (nnweb-type google))) gnus-select-method)))) -(defcustom gnus-group-fetch-control-use-browse-url nil - "*Non-nil means that control messages are displayed using `browse-url'. -Otherwise they are fetched with ange-ftp and displayed in an ephemeral -group." - :version "22.1" - :group 'gnus-group-various - :type 'boolean) - (defcustom gnus-use-cross-reference t "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in @@ -1503,7 +1463,7 @@ Also see `gnus-large-ephemeral-newsgroup'." integer)) (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v))) - "*Non-nil means that the default name of a file to save articles in is the group name. + "Non-nil means that the default name of a file to save articles in is the group name. If it's nil, the directory form of the group name is used instead. If 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 will not be used for kill files. Note that the default for this variable varies according to what system -type you're using. On `usg-unix-v' and `xenix' this variable defaults -to nil while on all other systems it defaults to t." +type you're using. On `usg-unix-v' this variable defaults to nil while +on all other systems it defaults to t." :group 'gnus-start :type '(radio (sexp :format "Non-nil\n" :match (lambda (widget value) @@ -2814,7 +2774,8 @@ gnus-registry.el will populate this if it's loaded.") ("gnus-cite" :interactive t gnus-article-highlight-citation gnus-article-hide-citation-maybe gnus-article-hide-citation gnus-article-fill-cited-article - gnus-article-hide-citation-in-followups) + gnus-article-hide-citation-in-followups + gnus-article-fill-cited-long-lines) ("gnus-kill" gnus-kill gnus-apply-kill-file-internal gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score) @@ -3585,16 +3546,6 @@ that that variable is buffer-local to the summary buffers." gnus-valid-select-methods))) (equal (nth 1 m1) (nth 1 m2))))))) -(defun gnus-methods-sloppily-equal (m1 m2) - ;; Same method. - (or - (eq m1 m2) - ;; Type and name are equal. - (and - (eq (car m1) (car m2)) - (equal (cadr m1) (cadr m2)) - (gnus-sloppily-equal-method-parameters m1 m2)))) - (defsubst gnus-sloppily-equal-method-parameters (m1 m2) ;; Check parameters for sloppy equalness. (let ((p1 (copy-sequence (cddr m1))) @@ -3623,6 +3574,16 @@ that that variable is buffer-local to the summary buffers." ;; If p2 now is empty, they were equal. (null p2)))) +(defun gnus-methods-sloppily-equal (m1 m2) + ;; Same method. + (or + (eq m1 m2) + ;; Type and name are equal. + (and + (eq (car m1) (car m2)) + (equal (cadr m1) (cadr m2)) + (gnus-sloppily-equal-method-parameters m1 m2)))) + (defun gnus-server-equal (m1 m2) "Say whether two methods are equal." (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'." (t value))) +(autoload 'nnheader-message "nnheader") + (defun mail-source-fetch (source callback &optional method) "Fetch mail from SOURCE and call CALLBACK zero or more times. CALLBACK 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) 0) (funcall callback mail-source-crash-box info))) +(autoload 'gnus-float-time "gnus-util") + (defvar mail-source-incoming-last-checked-time nil) (defun mail-source-delete-crash-box () @@ -614,7 +618,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; Don't check for old incoming files more than once per day to ;; save a lot of file accesses. (when (or (null mail-source-incoming-last-checked-time) - (> (time-to-seconds + (> (gnus-float-time (time-since mail-source-incoming-last-checked-time)) (* 24 60 60))) (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." ;;; Start of variables adopted from `message-utils.el'. -(defcustom message-subject-trailing-was-query 'ask +(defcustom message-subject-trailing-was-query t "*What to do with trailing \"(was: <old subject>)\" in subject lines. If nil, leave the subject unchanged. If it is the symbol `ask', query the 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 `message-subject-trailing-was-query' is t, always strip the trailing old subject. In this case, `message-subject-trailing-was-regexp' is used." - :version "22.1" + :version "24.1" :type '(choice (const :tag "never" nil) (const :tag "always strip" t) (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 @@ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> @@ -1324,6 +1324,8 @@ Use CMD as the process." (let ((coding-system-for-write 'binary)) (shell-command-on-region (point-min) (point-max) command nil))))) +(autoload 'gnus-completing-read "gnus-util") + (defun mm-interactively-view-part (handle) "Display HANDLE using METHOD." (let* ((type (mm-handle-media-type handle)) @@ -1683,6 +1685,7 @@ If RECURSIVE, search recursively." (start end &optional base-url)) (declare-function shr-insert-document "shr" (dom)) (defvar shr-blocked-images) +(autoload 'gnus-blocked-images "gnus-art") (defun mm-shr (handle) ;; 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 @@ (require 'timer))) (defvar mm-mime-mule-charset-alist ) +;; Note this is not presently used on Emacs >= 23, which is good, +;; since it means standalone message-mode (which requires mml and +;; hence mml-util) does not load gnus-util. +(autoload 'gnus-completing-read "gnus-util") ;; Emulate functions that are not available in every (X)Emacs version. ;; 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." (defalias 'mm-decode-coding-region 'decode-coding-region) (defalias 'mm-encode-coding-region 'encode-coding-region))) -;; `string-to-multibyte' is available only in Emacs 22.1 or greater. -(defalias 'mm-string-to-multibyte - (cond - ((featurep 'xemacs) - 'identity) - ((fboundp 'string-to-multibyte) - 'string-to-multibyte) - (t - (lambda (string) - "Return a multibyte string with the same individual chars as STRING." - (mapconcat - (lambda (ch) (mm-string-as-multibyte (char-to-string ch))) - string ""))))) +;; `string-to-multibyte' is available only in Emacs. +(defalias 'mm-string-to-multibyte (if (featurep 'xemacs) + 'identity + 'string-to-multibyte)) ;; `char-or-char-int-p' is an XEmacs function, not available in Emacs. (eval-and-compile @@ -272,18 +267,19 @@ to the contents of the accessible portion of the buffer." ;; Actually, there should be an `mm-coding-system-mime-charset'. (eval-and-compile (defalias 'mm-read-coding-system - (cond - ((fboundp 'read-coding-system) - (if (and (featurep 'xemacs) - (<= (string-to-number emacs-version) 21.1)) - (lambda (prompt &optional default-coding-system) - (read-coding-system prompt)) - 'read-coding-system)) - (t (lambda (prompt &optional default-coding-system) - "Prompt the user for a coding system." - (gnus-completing-read - prompt (mapcar (lambda (s) (symbol-name (car s))) - mm-mime-mule-charset-alist))))))) + (if (featurep 'emacs) 'read-coding-system + (cond + ((fboundp 'read-coding-system) + (if (and (featurep 'xemacs) + (<= (string-to-number emacs-version) 21.1)) + (lambda (prompt &optional default-coding-system) + (read-coding-system prompt)) + 'read-coding-system)) + (t (lambda (prompt &optional default-coding-system) + "Prompt the user for a coding system." + (gnus-completing-read + prompt (mapcar (lambda (s) (symbol-name (car s))) + mm-mime-mule-charset-alist)))))))) (defvar mm-coding-system-list nil) (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 @@ ;;; Functions for displaying various formats inline ;;; +(autoload 'gnus-rescale-image "gnus-util") + (defun mm-inline-image-emacs (handle) (let ((b (point-marker)) (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.") (setq body-end (point)) (push (list (incf i) head-begin head-end body-begin body-end (count-lines body-begin body-end)) - nndoc-dissection-alist))))))) + nndoc-dissection-alist))))) + (setq nndoc-dissection-alist (nreverse nndoc-dissection-alist)))) (defun nndoc-article-begin () (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 @@ (require 'utf7) (require 'tls) (require 'parse-time) +(require 'nnmail) + +(eval-when-compile + (require 'gnus-sum)) (autoload 'auth-source-forget-user-or-password "auth-source") (autoload 'auth-source-user-or-password "auth-source") @@ -78,6 +82,9 @@ Uses the same syntax as nnmail-split-methods") (defvoo nnimap-split-fancy nil "Uses the same syntax as nnmail-split-fancy.") +(defvoo nnimap-unsplittable-articles '(%Deleted %Seen) + "Articles with the flags in the list will not be considered when splitting.") + (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'" "Emacs 24.1") @@ -284,7 +291,7 @@ textual parts.") (with-current-buffer buffer (when (and nnimap-object (nnimap-last-command-time nnimap-object) - (> (time-to-seconds + (> (gnus-float-time (time-subtract now (nnimap-last-command-time nnimap-object))) @@ -292,7 +299,8 @@ textual parts.") (* 5 60))) (nnimap-send-command "NOOP"))))))) -(declare-function gnutls-negotiate "subr" (fn file &optional arglist fileonly)) +(declare-function gnutls-negotiate "gnutls" + (proc type &optional priority-string trustfiles keyfiles)) (defun nnimap-open-connection (buffer) (unless nnimap-keepalive-timer @@ -379,14 +387,13 @@ textual parts.") ;; connection and start a STARTTLS connection instead. (cond ((and (or (and (eq nnimap-stream 'network) - (member "STARTTLS" - (nnimap-capabilities nnimap-object))) + (nnimap-capability "STARTTLS")) (eq nnimap-stream 'starttls)) (fboundp 'open-gnutls-stream)) (nnimap-command "STARTTLS") (gnutls-negotiate (nnimap-process nnimap-object) nil)) ((and (eq nnimap-stream 'network) - (member "STARTTLS" (nnimap-capabilities nnimap-object))) + (nnimap-capability "STARTTLS")) (let ((nnimap-stream 'starttls)) (let ((tls-process (nnimap-open-connection buffer))) @@ -412,9 +419,18 @@ textual parts.") ;; physical address. (nnimap-credentials nnimap-address ports))))) (setq nnimap-object nil) - (setq login-result (nnimap-command "LOGIN %S %S" - (car credentials) - (cadr credentials))) + (setq login-result + (if (and (nnimap-capability "AUTH=PLAIN") + (nnimap-capability "LOGINDISABLED")) + (nnimap-command + "AUTHENTICATE PLAIN %s" + (base64-encode-string + (format "\000%s\000%s" + (nnimap-quote-specials (car credentials)) + (nnimap-quote-specials (cadr credentials))))) + (nnimap-command "LOGIN %S %S" + (car credentials) + (cadr credentials)))) (unless (car login-result) ;; If the login failed, then forget the credentials ;; that are now possibly cached. @@ -427,10 +443,20 @@ textual parts.") (delete-process (nnimap-process nnimap-object)) (setq nnimap-object nil)))) (when nnimap-object - (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) + (when (nnimap-capability "QRESYNC") (nnimap-command "ENABLE QRESYNC")) (nnimap-process nnimap-object)))))))) +(defun nnimap-quote-specials (string) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (re-search-forward "[\\\"]" nil t) + (forward-char -1) + (insert "\\") + (forward-char 1)) + (buffer-string))) + (defun nnimap-find-parameter (parameter elems) (let (result) (dolist (elem elems) @@ -533,8 +559,11 @@ textual parts.") (delete-region (point) (point-max))) t))) +(defun nnimap-capability (capability) + (member capability (nnimap-capabilities nnimap-object))) + (defun nnimap-ver4-p () - (member "IMAP4REV1" (nnimap-capabilities nnimap-object))) + (nnimap-capability "IMAP4REV1")) (defun nnimap-get-partial-article (article parts structure) (let ((result @@ -850,7 +879,7 @@ textual parts.") (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)" (nnimap-article-ranges articles)) (cond - ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) + ((nnimap-capability "UIDPLUS") (nnimap-command "UID EXPUNGE %s" (nnimap-article-ranges articles)) t) @@ -906,9 +935,12 @@ textual parts.") (nnimap-add-cr) (setq message (buffer-substring-no-properties (point-min) (point-max))) (with-current-buffer (nnimap-buffer) + (erase-buffer) (setq sequence (nnimap-send-command "APPEND %S {%d}" (utf7-encode group t) (length message))) + (unless nnimap-streaming + (nnimap-wait-for-connection "^[+]")) (process-send-string (get-buffer-process (current-buffer)) message) (process-send-string (get-buffer-process (current-buffer)) (if (nnimap-newlinep nnimap-object) @@ -1009,7 +1041,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (erase-buffer) (setf (nnimap-group nnimap-object) nil) - (let ((qresyncp (member "QRESYNC" (nnimap-capabilities nnimap-object))) + (let ((qresyncp (nnimap-capability "QRESYNC")) params groups sequences active uidvalidity modseq group) ;; Go through the infos and gather the data needed to know ;; what and how to request the data. @@ -1181,7 +1213,8 @@ textual parts.") (setq marks (gnus-info-marks info)) (dolist (type (cdr nnimap-mark-alist)) (when (or (not (listp permanent-flags)) - (memq (assoc (caddr type) flags) permanent-flags) + (memq (car (assoc (caddr type) flags)) + permanent-flags) (memq '%* permanent-flags)) (let ((old-marks (assoc (car type) marks)) (new-marks @@ -1454,12 +1487,14 @@ textual parts.") (nnimap-wait-for-response sequence) (nnimap-parse-response)) -(defun nnimap-wait-for-connection () +(defun nnimap-wait-for-connection (&optional regexp) + (unless regexp + (setq regexp "^[*.] .*\n")) (let ((process (get-buffer-process (current-buffer)))) (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) - (not (re-search-forward "^[*.] .*\n" nil t))) + (not (re-search-forward regexp nil t))) (nnheader-accept-process-output process) (goto-char (point-min))) (forward-line -1) @@ -1593,6 +1628,7 @@ textual parts.") new-articles) (erase-buffer) (nnimap-command "SELECT %S" nnimap-inbox) + (setf (nnimap-group nnimap-object) nnimap-inbox) (setq new-articles (nnimap-new-articles (nnimap-get-flags "1:*"))) (when new-articles (nnimap-fetch-inbox new-articles) @@ -1645,7 +1681,7 @@ textual parts.") (cond ;; If the server supports it, we now delete the message we have ;; just copied over. - ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) + ((nnimap-capability "UIDPLUS") (setq sequence (nnimap-send-command "UID EXPUNGE %s" range))) ;; If it doesn't support UID EXPUNGE, then we only expunge if the ;; user has configured it. @@ -1665,9 +1701,8 @@ textual parts.") (defun nnimap-new-articles (flags) (let (new) (dolist (elem flags) - (when (or (null (cdr elem)) - (and (not (memq '%Deleted (cdr elem))) - (not (memq '%Seen (cdr elem))))) + (unless (gnus-list-memq-of-list nnimap-unsplittable-articles + (cdr elem)) (push (car elem) new))) (gnus-compress-sequence (nreverse new)))) 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 @@ ;; TODO: Documentation in the Gnus manual -;; From: Reiner Steib -;; Subject: Re: Including nnir.el -;; Newsgroups: gmane.emacs.gnus.general -;; Message-ID: <v9d5dnp6aq.fsf@marauder.physik.uni-ulm.de> -;; Date: 2006-06-05 22:49:01 GMT -;; -;; On Sun, Jun 04 2006, Sascha Wilde wrote: -;; -;; > The one thing most hackers like to forget: Documentation. By now the -;; > documentation is only in the comments at the head of the source, I -;; > would use it as basis to cook up some minimal texinfo docs. -;; > -;; > Where in the existing gnus manual would this fit best? - -;; Maybe (info "(gnus)Combined Groups") for a general description. -;; `gnus-group-make-nnir-group' might be described in (info -;; "(gnus)Foreign Groups") as well. - - -;; The most recent version of this can always be fetched from the Gnus -;; repository. See http://www.gnus.org/ for more information. - -;; This code is still in the development stage but I'd like other -;; people to have a look at it. Please do not hesitate to contact me -;; with your ideas. +;; Where in the existing gnus manual would this fit best? -;; What does it do? Well, it allows you to index your mail using some -;; search engine (freeWAIS-sf, swish-e and others -- see later), -;; then type `G G' in the Group buffer and issue a query to the search -;; engine. You will then get a buffer which shows all articles -;; matching the query, sorted by Retrieval Status Value (score). +;; What does it do? Well, it allows you to search your mail using +;; some search engine (imap, namazu, swish-e, gmane and others -- see +;; later) by typing `G G' in the Group buffer. You will then get a +;; buffer which shows all articles matching the query, sorted by +;; Retrieval Status Value (score). ;; When looking at the retrieval result (in the Summary buffer) you ;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an ;; article. You will be teleported into the group this article came -;; from, showing the thread this article is part of. (See below for -;; restrictions.) +;; from, showing the thread this article is part of. -;; The Lisp installation is simple: just put this file on your -;; load-path, byte-compile it, and load it from ~/.gnus or something. -;; This will install a new command `G G' in your Group buffer for -;; searching your mail. Note that you also need to configure a number -;; of variables, as described below. - -;; Restrictions: -;; -;; * If you don't use HyREX as your search engine, this expects that -;; you use nnml or another one-file-per-message backend, because the -;; others doesn't support nnfolder. -;; * It can only search the mail backend's which are supported by one -;; search engine, because of different query languages. -;; * There are restrictions to the Wais setup. -;; * There are restrictions to the imap setup. -;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before -;; limiting to the right articles. This is much too slow, of -;; course. May issue a query for number of articles to fetch; you -;; must accept the default of all articles at this point or things -;; may break. - -;; The Lisp setup involves setting a few variables and setting up the +;; The Lisp setup may involve setting a few variables and setting up the ;; search engine. You can define the variables in the server definition ;; like this : ;; (setq gnus-secondary-select-methods '( ;; (nnimap "" (nnimap-address "localhost") -;; (nnir-search-engine hyrex) -;; (nnir-hyrex-additional-switches ("-d" "ddl-nnimap.xml")) +;; (nnir-search-engine namazu) ;; ))) -;; Or you can define the global ones. The variables set in the mailer- -;; definition will be used first. -;; The variable to set is `nnir-search-engine'. Choose one of the engines -;; listed in `nnir-engines'. (Actually `nnir-engines' is an alist, -;; type `C-h v nnir-engines RET' for more information; this includes -;; examples for setting `nnir-search-engine', too.) -;; -;; The variable nnir-mail-backend isn't used anymore. -;; +;; The main variable to set is `nnir-search-engine'. Choose one of +;; the engines listed in `nnir-engines'. (Actually `nnir-engines' is +;; an alist, type `C-h v nnir-engines RET' for more information; this +;; includes examples for setting `nnir-search-engine', too.) -;; You must also set up a search engine. I'll tell you about the two -;; search engines currently supported: +;; If you use one of the local indices (namazu, find-grep, swish) you +;; must also set up a search engine backend. -;; 1. freeWAIS-sf -;; -;; As always with freeWAIS-sf, you need a so-called `format file'. I -;; use the following file: -;; -;; ,----- -;; | # Kai's format file for freeWAIS-sf for indexing mails. -;; | # Each mail is in a file, much like the MH format. -;; | -;; | # Document separator should never match -- each file is a document. -;; | record-sep: /^@this regex should never match@$/ -;; | -;; | # Searchable fields specification. -;; | -;; | region: /^[sS]ubject:/ /^[sS]ubject: */ -;; | subject "Subject header" stemming TEXT BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */ -;; | to "To and Cc headers" SOUNDEX BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */ -;; | from "From header" SOUNDEX BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^$/ -;; | stemming TEXT GLOBAL -;; | end: /^@this regex should never match@$/ -;; `----- -;; -;; 1998-07-22: waisindex would dump core on me for large articles with -;; the above settings. I used /^$/ as the end regex for the global -;; field. That seemed to work okay. - -;; There is a Perl module called `WAIS.pm' which is available from -;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl. This -;; module comes with a nifty tool called `makedb', which I use for -;; indexing. Here's my `makedb.conf': -;; -;; ,----- -;; | # Config file for makedb -;; | -;; | # Global options -;; | waisindex = /usr/local/bin/waisindex -;; | wais_opt = -stem -t fields -;; | # `-stem' option necessary when `stemming' is specified for the -;; | # global field in the *.fmt file -;; | -;; | # Own variables -;; | homedir = /home/kai -;; | -;; | # The mail database. -;; | database = mail -;; | files = `find $homedir/Mail -name \*[0-9] -print` -;; | dbdir = $homedir/.wais -;; | limit = 100 -;; `----- -;; -;; The Lisp setup involves the `nnir-wais-*' variables. The most -;; difficult to understand variable is probably -;; `nnir-wais-remove-prefix'. Here's what it does: the output of -;; `waissearch' basically contains the file name and the (full) -;; directory name. As Gnus works with group names rather than -;; directory names, the directory name is transformed into a group -;; name as follows: first, a prefix is removed from the (full) -;; directory name, then all `/' are replaced with `.'. The variable -;; `nnir-wais-remove-prefix' should contain a regex matching exactly -;; this prefix. It defaults to `$HOME/Mail/' (note the trailing -;; slash). - -;; 2. Namazu +;; 1. Namazu ;; ;; The Namazu backend requires you to have one directory containing all ;; index files, this is controlled by the `nnir-namazu-index-directory' ;; variable. To function the `nnir-namazu-remove-prefix' variable must -;; also be correct, see the documentation for `nnir-wais-remove-prefix' +;; also be correct, see the documentation for `nnir-namazu-remove-prefix' ;; above. ;; ;; It is particularly important not to pass any any switches to namazu @@ -227,18 +104,7 @@ ;; For maximum searching efficiency I have a cron job set to run this ;; command every four hours. -;; 3. HyREX -;; -;; The HyREX backend requires you to have one directory from where all -;; your relative paths are to, if you use them. This directory must be -;; set in the `nnir-hyrex-index-directory' variable, which defaults to -;; your home directory. You must also pass the base, class and -;; directory options or simply your dll to the `nnir-hyrex-programm' by -;; setting the `nnir-hyrex-additional-switches' variable accordently. -;; To function the `nnir-hyrex-remove-prefix' variable must also be -;; correct, see the documentation for `nnir-wais-remove-prefix' above. - -;; 4. find-grep +;; 2. find-grep ;; ;; The find-grep engine simply runs find(1) to locate eligible ;; articles and searches them with grep(1). This, of course, is much @@ -294,43 +160,14 @@ ;; function should return the list of articles as a vector, as ;; described above. Then, you need to register this backend in ;; `nnir-engines'. Then, users can choose the backend by setting -;; `nnir-search-engine'. - -;; Todo, or future ideas: - -;; * It should be possible to restrict search to certain groups. -;; -;; * There is currently no error checking. -;; -;; * The summary buffer display is currently really ugly, with all the -;; added information in the subjects. How could I make this -;; prettier? -;; -;; * A function which can be called from an nnir summary buffer which -;; teleports you into the group the current article came from and -;; shows you the whole thread this article is part of. -;; Implementation suggestions? -;; (1998-07-24: There is now a preliminary implementation, but -;; it is much too slow and quite fragile.) -;; -;; * Support other mail backends. In particular, probably quite a few -;; people use nnfolder. How would one go about searching nnfolders -;; and producing the right data needed? The group name and the RSV -;; are simple, but what about the article number? -;; - The article number is encoded in the `X-Gnus-Article-Number' -;; header of each mail. -;; - The HyREX engine supports nnfolder. -;; -;; * Support compressed mail files. Probably, just stripping off the -;; `.gz' or `.Z' file name extension is sufficient. -;; -;; * At least for imap, the query is performed twice. -;; - -;; Have you got other ideas? +;; `nnir-search-engine' as a server variable. ;;; Setup Code: +;; For Emacs <22.2 and XEmacs. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (require 'nnoo) (require 'gnus-group) (require 'gnus-sum) @@ -350,118 +187,27 @@ (gnus-declare-backend "nnir" 'mail) -(defvar nnir-imap-default-search-key "Whole message" - "The default IMAP search key for an nnir search. Must be one of - the keys in nnir-imap-search-arguments. To use raw imap queries - by default set this to \"Imap\"") - -(defvar nnir-imap-search-arguments - '(("Whole message" . "TEXT") - ("Subject" . "SUBJECT") - ("To" . "TO") - ("From" . "FROM") - ("Imap" . "")) - "Mapping from user readable keys to IMAP search items for use in nnir") - -(defvar nnir-imap-search-other "HEADER %S" - "The IMAP search item to use for anything other than - nnir-imap-search-arguments. By default this is the name of an - email header field") - -(defvar nnir-imap-search-argument-history () - "The history for querying search options in nnir") - -(defvar nnir-get-article-nov-override-function nil - "If non-nil, a function that will be passed each search result. This -should return a message's headers in NOV format. - -If this variable is nil, or if the provided function returns nil for a search -result, `gnus-retrieve-headers' will be called instead.") - -(defvar nnir-method-default-engines - '((nnimap . imap) - (nntp . nil)) - "Alist of default search engines by server method") - -;;; Developer Extension Variable: - -(defvar nnir-engines - `((wais nnir-run-waissearch - ()) - (imap nnir-run-imap - ((criteria - "Search in" ; Prompt - ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing - nil ; allow any user input - nil ; initial value - nnir-imap-search-argument-history ; the history to use - ,nnir-imap-default-search-key ; default - ))) - (swish++ nnir-run-swish++ - ((group . "Group spec: "))) - (swish-e nnir-run-swish-e - ((group . "Group spec: "))) - (namazu nnir-run-namazu - ()) - (hyrex nnir-run-hyrex - ((group . "Group spec: "))) - (find-grep nnir-run-find-grep - ((grep-options . "Grep options: ")))) - "Alist of supported search engines. -Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). -ENGINE is a symbol designating the searching engine. FUNCTION is also -a symbol, giving the function that does the search. The third element -ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, -the FUNCTION will issue a query for each of the PARAMs, using PROMPT. - -The value of `nnir-search-engine' must be one of the ENGINE symbols. -For example, use the following line for searching using freeWAIS-sf: - (setq nnir-search-engine 'wais) -Use the following line if you read your mail via IMAP and your IMAP -server supports searching: - (setq nnir-search-engine 'imap) -Note that you have to set additional variables for most backends. For -example, the `wais' backend needs the variables `nnir-wais-program', -`nnir-wais-database' and `nnir-wais-remove-prefix'. - -Add an entry here when adding a new search engine.") ;;; User Customizable Variables: (defgroup nnir nil - "Search nnmh and nnml groups in Gnus with swish-e, freeWAIS-sf, or EWS." + "Search groups in Gnus with assorted seach engines." :group 'gnus) -;; Mail backend. - -;; TODO: -;; If `nil', use server parameters to find out which server to search. CCC -;; -(defcustom nnir-mail-backend '(nnml "") - "*Specifies which backend should be searched. -More precisely, this is used to determine from which backend to fetch the -messages found. - -This must be equal to an existing server, so maybe it is best to use -something like the following: - (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods)) -The above line works fine if the mail backend you want to search is -the first element of gnus-secondary-select-methods (`nth' starts counting -at zero)." - :type '(sexp) +(defcustom nnir-method-default-engines + '((nnimap . imap) + (nntp . gmane)) + "*Alist of default search engines keyed by server method" + :type '(alist) :group 'nnir) -;; Search engine to use. - -(defcustom nnir-search-engine 'wais - "*The search engine to use. Must be a symbol. -See `nnir-engines' for a list of supported engines, and for example -settings of `nnir-search-engine'." - :type '(sexp) +(defcustom nnir-imap-default-search-key "Whole message" + "*The default IMAP search key for an nnir search. Must be one of + the keys in `nnir-imap-search-arguments'. To use raw imap queries + by default set this to \"Imap\"" + :type '(string) :group 'nnir) -;; freeWAIS-sf. - (defcustom nnir-wais-program "waissearch" "*Name of waissearch executable." :type '(string) @@ -517,8 +263,8 @@ Instead, use this: in order to get a group name (albeit with / instead of .). This is a regular expression. -This variable is very similar to `nnir-wais-remove-prefix', except -that it is for swish++, not Wais." +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for swish++, not Namazu." :type '(regexp) :group 'nnir) @@ -568,8 +314,8 @@ This could be a server parameter." in order to get a group name (albeit with / instead of .). This is a regular expression. -This variable is very similar to `nnir-wais-remove-prefix', except -that it is for swish-e, not Wais. +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for swish-e, not Namazu. This could be a server parameter." :type '(regexp) @@ -637,11 +383,83 @@ Instead, use this: "*The prefix to remove from each file name returned by Namazu in order to get a group name (albeit with / instead of .). -This variable is very similar to `nnir-wais-remove-prefix', except -that it is for Namazu, not Wais." +For example, suppose that Namazu returns file names such as +\"/home/john/Mail/mail/misc/42\". For this example, use the following +setting: (setq nnir-namazu-remove-prefix \"/home/john/Mail/\") +Note the trailing slash. Removing this prefix gives \"mail/misc/42\". +`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to +arrive at the correct group name, \"mail.misc\"." :type '(directory) :group 'nnir) +;; Imap variables + +(defvar nnir-imap-search-arguments + '(("Whole message" . "TEXT") + ("Subject" . "SUBJECT") + ("To" . "TO") + ("From" . "FROM") + ("Imap" . "")) + "Mapping from user readable keys to IMAP search items for use in nnir") + +(defvar nnir-imap-search-other "HEADER %S" + "The IMAP search item to use for anything other than + `nnir-imap-search-arguments'. By default this is the name of an + email header field") + +(defvar nnir-imap-search-argument-history () + "The history for querying search options in nnir") + +;;; Developer Extension Variable: + +(defvar nnir-engines + `((wais nnir-run-waissearch + ()) + (imap nnir-run-imap + ((criteria + "Imap Search in" ; Prompt + ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing + nil ; allow any user input + nil ; initial value + nnir-imap-search-argument-history ; the history to use + ,nnir-imap-default-search-key ; default + ))) + (gmane nnir-run-gmane + ((author . "Gmane Author: "))) + (swish++ nnir-run-swish++ + ((group . "Swish++ Group spec: "))) + (swish-e nnir-run-swish-e + ((group . "Swish-e Group spec: "))) + (namazu nnir-run-namazu + ()) + (hyrex nnir-run-hyrex + ((group . "Hyrex Group spec: "))) + (find-grep nnir-run-find-grep + ((grep-options . "Grep options: ")))) + "Alist of supported search engines. +Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). +ENGINE is a symbol designating the searching engine. FUNCTION is also +a symbol, giving the function that does the search. The third element +ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, +the FUNCTION will issue a query for each of the PARAMs, using PROMPT. + +The value of `nnir-search-engine' must be one of the ENGINE symbols. +For example, for searching a server using namazu include + (nnir-search-engine namazu) +in the server definition. Note that you have to set additional +variables for most backends. For example, the `namazu' backend +needs the variables `nnir-namazu-program', +`nnir-namazu-index-directory' and `nnir-namazu-remove-prefix'. + +Add an entry here when adding a new search engine.") + +(defvar nnir-get-article-nov-override-function nil + "If non-nil, a function that will be passed each search result. This +should return a message's headers in NOV format. + +If this variable is nil, or if the provided function returns nil for a search +result, `gnus-retrieve-headers' will be called instead.") + ;;; Internal Variables: (defvar nnir-current-query nil @@ -659,43 +477,33 @@ that it is for Namazu, not Wais." (defvar nnir-tmp-buffer " *nnir*" "Internal: temporary buffer.") +(defvar nnir-search-history () + "Internal: the history for querying search options in nnir") + +(defvar nnir-extra-parms nil + "Internal: stores request for extra search parms") + ;;; Code: ;; Gnus glue. -(defun gnus-group-make-nnir-group (extra-parms query) +(defun gnus-group-make-nnir-group (nnir-extra-parms) "Create an nnir group. Asks for query." - (interactive "P\nsQuery: ") + (interactive "P") (setq nnir-current-query nil nnir-current-server nil nnir-current-group-marked nil nnir-artlist nil) - (let ((parms nil)) - (if extra-parms - (setq parms (nnir-read-parms query)) - (setq parms (list (cons 'query query)))) + (let* ((query (read-string "Query: " nil 'nnir-search-history)) + (parms (list (cons 'query query))) + (srv (if (gnus-server-server-name) + "all" ""))) (add-to-list 'parms (cons 'unique-id (message-unique-id)) t) (gnus-group-read-ephemeral-group - (concat "nnir:" (prin1-to-string parms)) '(nnir "") t - (cons (current-buffer) - gnus-current-window-configuration) + (concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t + (cons (current-buffer) gnus-current-window-configuration) nil))) -;; Why is this needed? Is this for compatibility with old/new gnusae? Using -;; gnus-group-server instead works for me. -- Justus Piater -(defmacro nnir-group-server (group) - "Return the server for a newsgroup GROUP. -The returned format is as `gnus-server-to-method' needs it. See -`gnus-group-real-prefix' and `gnus-group-real-name'." - `(let ((gname ,group)) - (if (string-match "^\\([^:]+\\):" gname) - (progn - (setq gname (match-string 1 gname)) - (if (string-match "^\\([^+]+\\)\\+\\(.+\\)$" gname) - (format "%s:%s" (match-string 1 gname) (match-string 2 gname)) - (concat gname ":"))) - (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method))))) - ;; Summary mode commands. (defun gnus-summary-nnir-goto-thread () @@ -710,22 +518,27 @@ and show thread that contains this article." (id (mail-header-id (gnus-summary-article-header))) (refs (split-string (mail-header-references (gnus-summary-article-header))))) - (if (eq (car (gnus-group-method group)) 'nnimap) - (progn (nnimap-possibly-change-group (gnus-group-short-name group) nil) - (with-current-buffer (nnimap-buffer) - (let* ((cmd (let ((value (format - "(OR HEADER REFERENCES %s HEADER Message-Id %s)" - id id))) - (dolist (refid refs value) - (setq value (format - "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)" - refid refid value))))) - (result (nnimap-command - "UID SEARCH %s" cmd))) - (gnus-summary-read-group-1 group t t gnus-summary-buffer nil - (and (car result) - (delete 0 (mapcar #'string-to-number - (cdr (assoc "SEARCH" (cdr result)))))))))) + (if (eq (car (gnus-find-method-for-group group)) 'nnimap) + (progn + (nnimap-possibly-change-group (gnus-group-short-name group) nil) + (with-current-buffer (nnimap-buffer) + (let* ((cmd + (let ((value + (format + "(OR HEADER REFERENCES %s HEADER Message-Id %s)" + id id))) + (dolist (refid refs value) + (setq value + (format + "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)" + refid refid value))))) + (result (nnimap-command "UID SEARCH %s" cmd))) + (gnus-summary-read-group-1 + group t t gnus-summary-buffer nil + (and (car result) + (delete 0 (mapcar + #'string-to-number + (cdr (assoc "SEARCH" (cdr result)))))))))) (gnus-summary-read-group-1 group t t gnus-summary-buffer nil (list backend-number)) (gnus-summary-limit (list backend-number)) @@ -759,24 +572,19 @@ and show thread that contains this article." (equal server nnir-current-server))) nnir-artlist ;; Cache miss. - (setq nnir-artlist (nnir-run-query group))) + (setq nnir-artlist (nnir-run-query group server))) (with-current-buffer nntp-server-buffer + (setq nnir-current-query group) + (when server (setq nnir-current-server server)) + (setq nnir-current-group-marked gnus-group-marked) (if (zerop (length nnir-artlist)) - (progn - (setq nnir-current-query nil - nnir-current-server nil - nnir-current-group-marked nil - nnir-artlist nil) - (nnheader-report 'nnir "Search produced empty results.")) + (nnheader-report 'nnir "Search produced empty results.") ;; Remember data for cache. - (setq nnir-current-query group) - (when server (setq nnir-current-server server)) - (setq nnir-current-group-marked gnus-group-marked) (nnheader-insert "211 %d %d %d %s\n" (nnir-artlist-length nnir-artlist) ; total # 1 ; first # (nnir-artlist-length nnir-artlist) ; last # - group)))) ; group name + group)))) ; group name (deffoo nnir-retrieve-headers (articles &optional group server fetch-old) (save-excursion @@ -795,7 +603,7 @@ and show thread that contains this article." (setq artfullgroup (nnir-artitem-group artitem)) (setq artno (nnir-artitem-number artitem)) (setq artgroup (gnus-group-real-name artfullgroup)) - (setq server (nnir-group-server artfullgroup)) + (setq server (gnus-group-server artfullgroup)) ;; retrieve NOV or HEAD data for this article, transform into ;; NOV data and prepend to `novdata' (set-buffer nntp-server-buffer) @@ -909,8 +717,8 @@ ready to be added to the list of search results." (defun nnir-run-waissearch (query server &optional group) "Run given query agains waissearch. Returns vector of (group name, file name) pairs (also vectors, actually)." - (when group - (error "The freeWAIS-sf backend cannot search specific groups")) + ;; (when group + ;; (error "The freeWAIS-sf backend cannot search specific groups")) (save-excursion (let ((qstring (cdr (assq 'query query))) (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server)) @@ -950,49 +758,50 @@ pairs (also vectors, actually)." (> (nnir-artitem-rsv x) (nnir-artitem-rsv y))))))))) -;; IMAP interface. -;; todo: -;; send queries as literals -;; handle errors - - -(defun nnir-run-imap (query srv &optional group-option) +;; imap interface +(defun nnir-run-imap (query srv &optional groups) "Run a search against an IMAP back-end server. This uses a custom query language parser; see `nnir-imap-make-query' for details on the language and supported extensions" (save-excursion (let ((qstring (cdr (assq 'query query))) - (server (cadr (gnus-server-to-method srv))) - (group (or group-option (gnus-group-group-name))) - (defs (caddr (gnus-server-to-method srv))) - (criteria (or (cdr (assq 'criteria query)) - (cdr (assoc nnir-imap-default-search-key - nnir-imap-search-arguments)))) - (gnus-inhibit-demon t) - artlist) + (server (cadr (gnus-server-to-method srv))) + (defs (caddr (gnus-server-to-method srv))) + (criteria (or (cdr (assq 'criteria query)) + (cdr (assoc nnir-imap-default-search-key + nnir-imap-search-arguments)))) + (gnus-inhibit-demon t) + (groups (or groups (nnir-get-active srv))) + artlist) (message "Opening server %s" server) - (condition-case () - (when (nnimap-possibly-change-group (gnus-group-short-name group) server) - (with-current-buffer (nnimap-buffer) - (message "Searching %s..." group) - (let ((arts 0) - (result - (nnimap-command "UID SEARCH %s" - (if (string= criteria "") - qstring - (nnir-imap-make-query criteria qstring) - )))) - (mapc - (lambda (artnum) - (push (vector group artnum 1) artlist) - (setq arts (1+ arts))) - (and (car result) - (delete 0 (mapcar #'string-to-number - (cdr (assoc "SEARCH" (cdr result))))))) - (message "Searching %s... %d matches" group arts))) - (message "Searching %s...done" group)) - (quit nil)) - (reverse artlist)))) + (apply + 'vconcat + (mapcar + (lambda (x) + (let ((group x)) + (condition-case () + (when (nnimap-possibly-change-group + (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let ((arts 0) + (result (nnimap-command "UID SEARCH %s" + (if (string= criteria "") + qstring + (nnir-imap-make-query + criteria qstring))))) + (mapc + (lambda (artnum) (push (vector group artnum 1) artlist) + (setq arts (1+ arts))) + (and (car result) + (delete 0 (mapcar #'string-to-number + (cdr (assoc "SEARCH" + (cdr result))))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) + (reverse artlist))) + groups))))) (defun nnir-imap-make-query (criteria qstring) "Parse the query string and criteria into an appropriate IMAP search @@ -1182,8 +991,8 @@ actually). Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on Windows NT 4.0." - (when group - (error "The swish++ backend cannot search specific groups")) + ;; (when group + ;; (error "The swish++ backend cannot search specific groups")) (save-excursion (let ( (qstring (cdr (assq 'query query))) @@ -1271,8 +1080,8 @@ actually). Tested with swish-e-2.0.1 on Windows NT 4.0." ;; swish-e crashes with empty parameter to "-w" on commandline... - (when group - (error "The swish-e backend cannot search specific groups")) + ;; (when group + ;; (error "The swish-e backend cannot search specific groups")) (save-excursion (let ((qstring (cdr (assq 'query query))) @@ -1364,19 +1173,13 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (qstring (cdr (assq 'query query))) (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) score artno dirnam) - (when (and group groupspec) - (error (concat "It does not make sense to use a group spec" - " with process-marked groups."))) - (when group - (setq groupspec (gnus-group-real-name group))) - (when (and group (not (equal group (nnir-group-full-name groupspec server)))) - (message "%s vs. %s" group (nnir-group-full-name groupspec server)) - (error "Server with groupspec doesn't match group !")) + (when (and (not groupspec) group) + (setq groupspec + (regexp-opt + (mapcar (lambda (x) (gnus-group-real-name x)) group)))) (set-buffer (get-buffer-create nnir-tmp-buffer)) (erase-buffer) - (if groupspec - (message "Doing hyrex-search query %s on %s..." query groupspec) - (message "Doing hyrex-search query %s..." query)) + (message "Doing hyrex-search query %s..." query) (let* ((cp-list `( ,nnir-hyrex-program nil ; input from /dev/null @@ -1398,16 +1201,14 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; the user wants it. (when (> gnus-verbose 6) (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer ! - (if groupspec - (message "Doing hyrex-search query \"%s\" on %s...done" qstring groupspec) - (message "Doing hyrex-search query \"%s\"...done" qstring)) + (message "Doing hyrex-search query \"%s\"...done" qstring) (sit-for 0) ;; nnir-search returns: ;; for nnml/nnfolder: "filename mailid weigth" ;; for nnimap: "group mailid weigth" (goto-char (point-min)) (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") - ;; HyREX couldn't search directly in groups -- so filter out here. + ;; HyREX doesn't search directly in groups -- so filter out here. (when groupspec (keep-lines groupspec)) ;; extract data from result lines @@ -1441,8 +1242,8 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." pairs (also vectors, actually). Tested with Namazu 2.0.6 on a GNU/Linux system." - (when group - (error "The Namazu backend cannot search specific groups")) + ;; (when group + ;; (error "The Namazu backend cannot search specific groups")) (save-excursion (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir") ":[0-9]+" @@ -1504,7 +1305,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (> (nnir-artitem-rsv x) (nnir-artitem-rsv y))))))))) -(defun nnir-run-find-grep (query server &optional group) +(defun nnir-run-find-grep (query server &optional grouplist) "Run find and grep to obtain matching articles." (let* ((method (gnus-server-to-method server)) (sym (intern @@ -1516,65 +1317,139 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (unless directory (error "No directory found in method specification of server %s" server)) - (message "Searching %s using find-grep..." (or group server)) - (save-window-excursion - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (if (> gnus-verbose 6) - (pop-to-buffer (current-buffer))) - (cd directory) ; Using relative paths simplifies postprocessing. - (let ((group - (if (not group) - "." - ;; Try accessing the group literally as well as - ;; interpreting dots as directory separators so the - ;; engine works with plain nnml as well as the Gnus Cache. - (let ((group (gnus-group-real-name group))) - ;; Replace cl-func find-if. - (if (file-directory-p group) - group - (if (file-directory-p - (setq group (gnus-replace-in-string group "\\." "/" t))) - group)))))) - (unless group - (error "Cannot locate directory for group")) - (save-excursion - (apply - 'call-process "find" nil t - "find" group "-type" "f" "-name" "[0-9]*" "-exec" - "grep" - `("-l" ,@(and grep-options - (split-string grep-options "\\s-" t)) - "-e" ,regexp "{}" "+")))) - - ;; Translate relative paths to group names. - (while (not (eobp)) - (let* ((path (split-string - (buffer-substring (point) (line-end-position)) "/" t)) - (art (string-to-number (car (last path))))) - (while (string= "." (car path)) - (setq path (cdr path))) - (let ((group (mapconcat 'identity - ;; Replace cl-func: (subseq path 0 -1) - (let ((end (1- (length path))) - res) - (while (>= (setq end (1- end)) 0) - (push (pop path) res)) - (nreverse res)) - "."))) - (push (vector (nnir-group-full-name group server) art 0) - artlist)) - (forward-line 1))) - (message "Searching %s using find-grep...done" (or group server)) - artlist))) + (apply + 'vconcat + (mapcar (lambda (x) + (let ((group x)) + (message "Searching %s using find-grep..." + (or group server)) + (save-window-excursion + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (if (> gnus-verbose 6) + (pop-to-buffer (current-buffer))) + (cd directory) ; Using relative paths simplifies + ; postprocessing. + (let ((group + (if (not group) + "." + ;; Try accessing the group literally as + ;; well as interpreting dots as directory + ;; separators so the engine works with + ;; plain nnml as well as the Gnus Cache. + (let ((group (gnus-group-real-name group))) + ;; Replace cl-func find-if. + (if (file-directory-p group) + group + (if (file-directory-p + (setq group + (gnus-replace-in-string + group + "\\." "/" t))) + group)))))) + (unless group + (error "Cannot locate directory for group")) + (save-excursion + (apply + 'call-process "find" nil t + "find" group "-type" "f" "-name" "[0-9]*" "-exec" + "grep" + `("-l" ,@(and grep-options + (split-string grep-options "\\s-" t)) + "-e" ,regexp "{}" "+")))) + + ;; Translate relative paths to group names. + (while (not (eobp)) + (let* ((path (split-string + (buffer-substring + (point) + (line-end-position)) "/" t)) + (art (string-to-number (car (last path))))) + (while (string= "." (car path)) + (setq path (cdr path))) + (let ((group (mapconcat 'identity + ;; Replace cl-func: + ;; (subseq path 0 -1) + (let ((end (1- (length path))) + res) + (while + (>= (setq end (1- end)) 0) + (push (pop path) res)) + (nreverse res)) + "."))) + (push + (vector (nnir-group-full-name group server) art 0) + artlist)) + (forward-line 1))) + (message "Searching %s using find-grep...done" + (or group server)) + artlist))) + grouplist)))) + +(declare-function mm-url-insert "mm-url" (url &optional follow-refresh)) +(declare-function mm-url-encode-www-form-urlencoded "mm-url" (pairs)) + +;; gmane interface +(defun nnir-run-gmane (query srv &optional groups) + "Run a search against a gmane back-end server." + (if (gnus-string-match-p "gmane" srv) + (let* ((case-fold-search t) + (qstring (cdr (assq 'query query))) + (server (cadr (gnus-server-to-method srv))) + (groupspec (if groups + (mapconcat + (function (lambda (x) + (format "group:%s" + (gnus-group-short-name x)))) + groups " ") "")) + (authorspec + (if (assq 'author query) + (format "author:%s" (cdr (assq 'author query))) "")) + (search (format "%s %s %s" + qstring groupspec authorspec)) + artlist) + (require 'mm-url) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (mm-url-insert + (concat + "http://search.gmane.org/nov.php" + "?" + (mm-url-encode-www-form-urlencoded + `(("query" . ,search) + ("HITSPERPAGE" . "999"))))) + (unless (featurep 'xemacs) (set-buffer-multibyte t)) + (mm-decode-coding-region (point-min) (point-max) 'utf-8) + (goto-char (point-min)) + (forward-line 1) + (while (not (eobp)) + (unless (or (eolp) (looking-at "\x0d")) + (let ((header (nnheader-parse-nov))) + (let ((xref (mail-header-xref header)) + (xscore (string-to-number (cdr (assoc 'X-Score + (mail-header-extra header)))))) + (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref) + (push + (vector + (gnus-group-prefixed-name (match-string 1 xref) srv) + (string-to-number (match-string 2 xref)) xscore) + artlist))))) + (forward-line 1))) + ;; Sort by score + (apply 'vector + (sort artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))) + (message "Can't search non-gmane nntp groups"))) ;;; Util Code: -(defun nnir-read-parms (query) +(defun nnir-read-parms (query nnir-search-engine) "Reads additional search parameters according to `nnir-engines'." (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) - (cons (cons 'query query) - (mapcar 'nnir-read-parm parmspec)))) + (nconc query + (mapcar 'nnir-read-parm parmspec)))) (defun nnir-read-parm (parmspec) "Reads a single search parameter. @@ -1588,69 +1463,45 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (cons sym (format (cdr mapping) result))) (cons sym (read-string prompt))))) -(defun nnir-run-query (query) +(defun nnir-run-query (query nserver) "Invoke appropriate search engine function (see `nnir-engines'). -If some groups were process-marked, run the query for each of the groups -and concat the results." - (let ((q (car (read-from-string query)))) - (if gnus-group-marked - (apply 'vconcat - (mapcar (lambda (x) - (let* ((server (nnir-group-server x)) - (engine - (or (nnir-read-server-parm 'nnir-search-engine - server) - (cdr - (assoc (car (gnus-server-to-method server)) - nnir-method-default-engines)))) - search-func) - (setq search-func (cadr - (assoc - engine - nnir-engines))) - (if search-func - (funcall search-func q server x) - nil))) - gnus-group-marked)) - (apply 'vconcat - (mapcar (lambda (x) - (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral"))) - (let* ((server (format "%s:%s" (caar x) (cadar x))) - (engine - (or (nnir-read-server-parm 'nnir-search-engine - server) - (cdr - (assoc (car (gnus-server-to-method server)) - nnir-method-default-engines)))) - search-func) - (setq search-func (cadr - (assoc - engine + If some groups were process-marked, run the query for each of the groups + and concat the results." + (let ((q (car (read-from-string query))) + (groups (if (string= "all-ephemeral" nserver) + (with-current-buffer gnus-server-buffer + (list (list (gnus-server-server-name)))) + (nnir-sort-groups-by-server + (or gnus-group-marked (list (gnus-group-group-name))))))) + (apply 'vconcat + (mapcar (lambda (x) + (let* ((server (car x)) + (nnir-search-engine + (or (nnir-read-server-parm 'nnir-search-engine + server) + (cdr (assoc (car + (gnus-server-to-method server)) + nnir-method-default-engines)))) + search-func) + (setq search-func (cadr + (assoc nnir-search-engine nnir-engines))) - (if search-func - (funcall search-func q server nil) - nil)) - nil)) - gnus-opened-servers) - )) - )) + (if search-func + (funcall search-func + (if nnir-extra-parms + (nnir-read-parms q nnir-search-engine) + q) + server (cdr x)) + nil))) + groups)))) (defun nnir-read-server-parm (key server) - "Returns the parameter value of for the given server, where server is of -form 'backend:name'." + "Returns the parameter value of key for the given server, where +server is of form 'backend:name'." (let ((method (gnus-server-to-method server))) (cond ((and method (assq key (cddr method))) - (nth 1 (assq key (cddr method)))) - ((and nnir-mail-backend - (gnus-server-equal method nnir-mail-backend)) - (symbol-value key)) - (t nil)))) -;; (if method -;; (if (assq key (cddr method)) -;; (nth 1 (assq key (cddr method))) -;; (symbol-value key)) -;; (symbol-value key)) -;; )) + (nth 1 (assq key (cddr method)))) + (t nil)))) (defun nnir-group-full-name (shortname server) "For the given group name, return a full Gnus group name. @@ -1693,8 +1544,8 @@ The Gnus backend/server information is added." (elt artitem 2)) (defun nnir-artlist-artitem-rsv (artlist n) - "Returns from ARTLIST the Retrieval Status Value of the Nth artitem -\(counting from 1)." + "Returns from ARTLIST the Retrieval Status Value of the Nth +artitem (counting from 1)." (nnir-artitem-rsv (nnir-artlist-article artlist n))) ;; unused? @@ -1709,6 +1560,55 @@ The Gnus backend/server information is added." with-dups) res)) +(defun nnir-sort-groups-by-server (groups) + "sorts a list of groups into an alist keyed by server" +(if (car groups) + (let (value) + (dolist (var groups value) + (let ((server (gnus-group-server var))) + (if (assoc server value) + (nconc (cdr (assoc server value)) (list var)) + (push (cons (gnus-group-server var) (list var)) value)))) + value) + nil)) + +(defun nnir-get-active (srv) + (let ((method (gnus-server-to-method srv)) + groups) + (gnus-request-list method) + (with-current-buffer nntp-server-buffer + (let ((cur (current-buffer)) + name) + (goto-char (point-min)) + (unless (string= gnus-ignored-newsgroups "") + (delete-matching-lines gnus-ignored-newsgroups)) + ;; We treat NNTP as a special case to avoid problems with + ;; garbage group names like `"foo' that appear in some badly + ;; managed active files. -jh. + (if (eq (car method) 'nntp) + (while (not (eobp)) + (ignore-errors + (push (cons + (mm-string-as-unibyte + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point)))) + (let ((last (read cur))) + (cons (read cur) last))) + groups)) + (forward-line)) + (while (not (eobp)) + (ignore-errors + (push (mm-string-as-unibyte + (let ((p (point))) + (skip-chars-forward "^ \t\\\\") + (setq name (buffer-substring (+ p 1) (- (point) 1))) + (gnus-group-full-name name method))) + groups)) + (forward-line))))) + groups)) ;; The end. (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 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news, mail @@ -1347,7 +1348,7 @@ Eudora has a broken References line, but an OK In-Reply-To." ;;; Utility functions (declare-function gnus-activate-group "gnus-start" - (group &optional scan dont-check method)) + (group &optional scan dont-check method dont-sub-check)) (defun nnmail-do-request-post (accept-func &optional server) "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." (not (member (car server) gnus-ephemeral-servers)) (not (member (gnus-method-to-server (car server)) occ))) (push - (list mserver) + mserver openedserver))) openedserver)) 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 @@ ;;; nntp.el --- nntp access for Gnus -;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, -;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, +;; 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -1172,7 +1172,7 @@ It will make innd servers spawn an nnrpd process to allow actual article reading." (nntp-send-command "^.*\n" "MODE READER")) -(declare-function netrc-parse "netrc" (file)) +(declare-function netrc-parse "netrc" (&optional file)) (declare-function netrc-machine "netrc" (list machine &optional port defaultport)) (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.") (defvar shr-list-mode nil) (defvar shr-content-cache nil) (defvar shr-kinsoku-shorten nil) +(defvar shr-table-depth 0) (defvar shr-map (let ((map (make-sparse-keymap))) @@ -180,7 +181,7 @@ redirects somewhere else." result)) (dolist (sub dom) (if (stringp sub) - (push (cons :text sub) result) + (push (cons 'text sub) result) (push (shr-transform-dom sub) result))) (nreverse result))) @@ -193,7 +194,7 @@ redirects somewhere else." (defun shr-generic (cont) (dolist (sub cont) (cond - ((eq (car sub) :text) + ((eq (car sub) 'text) (shr-insert (cdr sub))) ((listp (cdr sub)) (shr-descend sub))))) @@ -285,7 +286,9 @@ redirects somewhere else." (aref (char-category-set (following-char)) ?>))) (backward-char 1)) (while (and (>= (setq count (1- count)) 0) - (aref (char-category-set (following-char)) ?>)) + (aref (char-category-set (following-char)) ?>) + (aref fill-find-break-point-function-table + (following-char))) (forward-char 1))) (when (eq (following-char) ? ) (forward-char 1)) @@ -369,16 +372,17 @@ redirects somewhere else." (let ((alt (buffer-substring start end)) (inhibit-read-only t)) (delete-region start end) - (shr-put-image data start alt)))))) + (goto-char start) + (shr-put-image data alt)))))) (kill-buffer (current-buffer))) -(defun shr-put-image (data point alt) - (if (not (display-graphic-p)) - (insert alt) - (let ((image (ignore-errors - (shr-rescale-image data)))) - (when image - (put-image image point alt))))) +(defun shr-put-image (data alt) + (if (display-graphic-p) + (let ((image (ignore-errors + (shr-rescale-image data)))) + (when image + (insert-image image (or alt "*")))) + (insert alt))) (defun shr-rescale-image (data) (if (or (not (fboundp 'imagemagick-types)) @@ -407,6 +411,10 @@ redirects somewhere else." image))) image))) +;; url-cache-extract autoloads url-cache. +(declare-function url-cache-create-filename "url-cache" (url)) +(autoload 'mm-disable-multibyte "mm-util") + (defun shr-get-image-data (url) "Get image data for URL. Return a string with image data." @@ -424,6 +432,8 @@ Return a string with image data." (apply #'shr-fontize-cont cont types) (shr-ensure-paragraph)) +(autoload 'widget-convert-button "wid-edit") + (defun shr-urlify (start url) (widget-convert-button 'url-link start (point) @@ -468,14 +478,6 @@ Return a string with image data." (defun shr-tag-s (cont) (shr-fontize-cont cont 'strike-through)) -(defun shr-tag-span (cont) - (let ((start (point)) - (color (cdr (assq 'color (shr-parse-style (cdr (assq :style cont))))))) - (shr-generic cont) - (when color - (let ((overlay (make-overlay start (point)))) - (overlay-put overlay 'face (cons 'foreground-color color)))))) - (defun shr-parse-style (style) (when style (let ((plist nil)) @@ -499,24 +501,43 @@ Return a string with image data." (shr-urlify (or shr-start start) url))) (defun shr-tag-object (cont) - (let ((url (cdr (assq :src (cdr (assq 'embed cont))))) - (start (point))) + (let ((start (point)) + url) + (dolist (elem cont) + (when (eq (car elem) 'embed) + (setq url (or url (cdr (assq :src (cdr elem)))))) + (when (and (eq (car elem) 'param) + (equal (cdr (assq :name (cdr elem))) "movie")) + (setq url (or url (cdr (assq :value (cdr elem))))))) (when url (shr-insert " [multimedia] ") - (shr-urlify start url)))) + (shr-urlify start url)) + (shr-generic cont))) + +(defun shr-tag-video (cont) + (let ((image (cdr (assq :poster cont))) + (url (cdr (assq :src cont))) + (start (point))) + (shr-tag-img nil image) + (shr-urlify start url))) -(defun shr-tag-img (cont) - (when (and cont - (cdr (assq :src cont))) +(defun shr-tag-img (cont &optional url) + (when (or url + (and cont + (cdr (assq :src cont)))) (when (and (> (current-column) 0) (not (eq shr-state 'image))) (insert "\n")) (let ((alt (cdr (assq :alt cont))) - (url (cdr (assq :src cont)))) + (url (or url (cdr (assq :src cont))))) (let ((start (point-marker))) (when (zerop (length alt)) - (setq alt "[img]")) + (setq alt "*")) (cond + ((or (member (cdr (assq :height cont)) '("0" "1")) + (member (cdr (assq :width cont)) '("0" "1"))) + ;; Ignore zero-sized or single-pixel images. + ) ((and (not shr-inhibit-images) (string-match "\\`cid:" url)) (let ((url (substring url (match-end 0))) @@ -524,7 +545,7 @@ Return a string with image data." (if (or (not shr-content-function) (not (setq image (funcall shr-content-function url)))) (insert alt) - (shr-put-image image (point) alt)))) + (shr-put-image image alt)))) ((or shr-inhibit-images (and shr-blocked-images (string-match shr-blocked-images url))) @@ -534,17 +555,17 @@ Return a string with image data." (shr-insert (substring alt 0 8)) (shr-insert alt)))) ((url-is-cached (shr-encode-url url)) - (shr-put-image (shr-get-image-data url) (point) alt)) + (shr-put-image (shr-get-image-data url) alt)) (t (insert alt) (ignore-errors (url-retrieve (shr-encode-url url) 'shr-image-fetched (list (current-buffer) start (point-marker)) t)))) - (insert " ") (put-text-property start (point) 'keymap shr-map) (put-text-property start (point) 'shr-alt alt) (put-text-property start (point) 'shr-image url) + (put-text-property start (point) 'help-echo alt) (setq shr-state 'image))))) (defun shr-tag-pre (cont) @@ -628,6 +649,7 @@ Return a string with image data." (setq cont (or (cdr (assq 'tbody cont)) cont)) (let* ((shr-inhibit-images t) + (shr-table-depth (1+ shr-table-depth)) (shr-kinsoku-shorten t) ;; Find all suggested widths. (columns (shr-column-specs cont)) @@ -649,8 +671,9 @@ Return a string with image data." ;; Finally, insert all the images after the table. The Emacs buffer ;; model isn't strong enough to allow us to put the images actually ;; into the tables. - (dolist (elem (shr-find-elements cont 'img)) - (shr-tag-img (cdr elem)))) + (when (zerop shr-table-depth) + (dolist (elem (shr-find-elements cont 'img)) + (shr-tag-img (cdr elem))))) (defun shr-tag-table (cont) (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 @@ ;;; sieve-manage.el --- Implementation of the managesive protocol in elisp -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> @@ -79,6 +79,7 @@ (require 'password)) (eval-when-compile + (require 'cl) ; caddr (require 'sasl) (require 'starttls)) (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." (kill-buffer digbuf) retbuf)) +(declare-function ldap-search "ldap" + (filter &optional host attributes attrsonly withdn)) + (defun smime-cert-by-ldap-1 (mail host) "Get cetificate for MAIL from the ldap server at HOST." (let ((ldapresult @@ -595,7 +598,9 @@ A string or a list of strings is returned." (progn (require 'smime-ldap) 'smime-ldap-search) - 'ldap-search) + (progn + (require 'ldap) + 'ldap-search)) (concat "mail=" mail) host '("userCertificate") nil)) (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 @@ ;; info.el --- info package for Emacs -;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help @@ -3379,6 +3379,8 @@ Build a menu of the possible matches." (declare-function find-library-name "find-func" (library)) (declare-function finder-unknown-keywords "finder" ()) (declare-function lm-commentary "lisp-mnt" (&optional file)) +(defvar finder-keywords-hash) +(defvar package-alist) ; finder requires package (defun Info-finder-find-node (filename nodename &optional no-going-back) "Finder-specific implementation of Info-find-node-2." @@ -4930,5 +4932,4 @@ type returned by `Info-bookmark-make-record', which see." (provide 'info) -;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac ;;; 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 @@ (define-key global-map [menu-bar help-menu] (cons (purecopy "Info") menu-bar-help-menu))) -;; This alias is for compatibility with 19.28 and before. -(defvar menu-bar-files-menu menu-bar-file-menu) +;; Only declared obsolete (and only made a proper alias) in 23.3. +(define-obsolete-variable-alias 'menu-bar-files-menu 'menu-bar-file-menu "22.1") ;; This is referenced by some code below; it is defined in uniquify.el (defvar uniquify-buffer-name-style) @@ -2073,7 +2073,8 @@ With a numeric argument, if the argument is positive, turn on menu bars; otherwise, turn off menu bars." :init-value t :global t - :group 'frames + ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. + :variable menu-bar-mode ;; Turn the menu-bars on all frames on or off. (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 @@ ;;; mouse-sel.el --- multi-click selection support for Emacs 19 -;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Mike Williams <mdub@bigfoot.com> ;; Keywords: mouse @@ -299,7 +299,7 @@ where SELECTION-NAME = name of selection SELECTION-THING-SYMBOL = name of variable where the current selection type for this selection should be stored.") -(declare-function x-select-text "term/x-win" (text)) +(declare-function x-select-text "term/common-win" (text)) (defvar mouse-sel-set-selection-function (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) @@ -314,7 +314,7 @@ Called with two arguments: SELECTION, the name of the selection concerned, and VALUE, the text to store. -This sets the selection, unless `mouse-sel-default-bindings' +This sets the selection, unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.") (declare-function x-selection-value "term/x-win" ()) @@ -749,5 +749,4 @@ If `mouse-yank-at-point' is non-nil, insert at point instead." (provide 'mouse-sel) -;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7 ;;; 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 @@ ;;; gnutls.el --- Support SSL/TLS connections through GnuTLS + ;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Ted Zlatanov <tzz@lifelogs.com> @@ -65,6 +66,8 @@ trust and key files, and priority string." (let ((proc (open-network-stream name buffer host service))) (gnutls-negotiate proc 'gnutls-x509pki))) +(declare-function gnutls-boot "gnutls.c" (proc type proplist)) + (defun gnutls-negotiate (proc type &optional priority-string trustfiles keyfiles) "Negotiate a SSL/TLS connection. @@ -95,6 +98,9 @@ KEYFILES is a list of client keys." proc)) +(declare-function gnutls-errorp "gnutls.c" (error)) +(declare-function gnutls-error-string "gnutls.c" (error)) + (defun gnutls-message-maybe (doit format &rest params) "When DOIT, message with the caller name followed by FORMAT on PARAMS." ;; (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." (setq buffer-file-name filename) (setq buffer-read-only (not (file-writable-p filename))) (set-visited-file-modtime) - (set-buffer-modified-p nil)) + (set-buffer-modified-p nil) + ;; For root, preserve owner and group when editing files. + (when (string-equal (file-remote-p filename 'user) "root") + (set (make-local-variable 'backup-by-copying-when-mismatch) t) + (put 'backup-by-copying-when-mismatch 'permanent-local t))) (when (and (stringp local-copy) (or remote-copy (null tramp-temp-buffer-file-name))) (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 @@ ;;; fortune.el --- use fortune to create signatures -;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Holger Schauer <Holger.Schauer@gmx.de> ;; Keywords: games utils mail @@ -285,48 +285,41 @@ and choose the directory as the fortune-file." ;;; Display fortune (defun fortune-in-buffer (interactive &optional file) "Put a fortune cookie in the *fortune* buffer. - -INTERACTIVE is ignored. Optional argument FILE, -when supplied, specifies the file to choose the fortune from." +INTERACTIVE is ignored. Optional argument FILE, when supplied, +specifies the file to choose the fortune from." (let ((fortune-buffer (or (get-buffer fortune-buffer-name) (generate-new-buffer fortune-buffer-name))) (fort-file (expand-file-name (substitute-in-file-name (or file fortune-file))))) (with-current-buffer fortune-buffer - (toggle-read-only 0) - (erase-buffer) - - (if fortune-always-compile - (fortune-compile fort-file)) - - (apply 'call-process - fortune-program ; program to call - nil fortune-buffer nil ; INFILE BUFFER DISPLAY - (append (if (stringp fortune-program-options) - (split-string fortune-program-options) - fortune-program-options) (list fort-file)))))) + (let ((inhibit-read-only t)) + (erase-buffer) + (if fortune-always-compile + (fortune-compile fort-file)) + (apply 'call-process + fortune-program ; program to call + nil fortune-buffer nil ; INFILE BUFFER DISPLAY + (append (if (stringp fortune-program-options) + (split-string fortune-program-options) + fortune-program-options) (list fort-file))))))) ;;;###autoload (defun fortune (&optional file) "Display a fortune cookie. - If called with a prefix asks for the FILE to choose the fortune from, otherwise uses the value of `fortune-file'. If you want to have fortune choose from a set of files in a directory, call interactively with prefix and choose the directory as the fortune-file." - (interactive - (list - (if current-prefix-arg - (fortune-ask-file) - fortune-file))) + (interactive (list (if current-prefix-arg + (fortune-ask-file) + fortune-file))) (fortune-in-buffer t file) (switch-to-buffer (get-buffer fortune-buffer-name)) - (toggle-read-only 1)) + (setq buffer-read-only t)) ;;; Provide ourselves. (provide 'fortune) -;; arch-tag: a1e4cb8a-3792-40e7-86a7-fc75ce094bcc ;;; 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 @@ ;;; gomoku.el --- Gomoku game between you and Emacs -;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr> ;; Maintainer: FSF @@ -195,8 +195,8 @@ Other useful commands:\n \\{gomoku-mode-map}" (gomoku-display-statistics) (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(gomoku-font-lock-keywords t)) - (toggle-read-only t)) + (setq font-lock-defaults '(gomoku-font-lock-keywords t) + buffer-read-only t)) ;;; ;;; THE BOARD. @@ -1206,5 +1206,4 @@ If the game is finished, this command requests for another game." (provide 'gomoku) -;; arch-tag: b1b8205e-77fc-4597-b373-3ea2c04311eb ;;; 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'." (lm-display-statistics) (use-local-map lm-mode-map) (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(lm-font-lock-keywords t)) - (toggle-read-only t) + (setq font-lock-defaults '(lm-font-lock-keywords t) + buffer-read-only t) (run-mode-hooks 'lm-mode-hook)) @@ -1702,5 +1702,4 @@ Use \\[describe-mode] for more info." (provide 'landmark) -;; arch-tag: ae5031be-96e6-459e-a3df-1df53117d3f2 ;;; 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 @@ ;;; ada-mode.el --- major-mode for editing Ada sources -;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Rolf Ebert <ebert@inf.enst.fr> ;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> @@ -1117,9 +1118,9 @@ the file name." (funcall (symbol-function 'speedbar-add-supported-extension) spec) (funcall (symbol-function 'speedbar-add-supported-extension) - body))) - ) + body)))) +(defvar ada-font-lock-syntactic-keywords) ; defined below ;;;###autoload (defun ada-mode () @@ -5538,5 +5539,4 @@ This function typically is to be hooked into `ff-file-created-hook'." ;;; provide ourselves (provide 'ada-mode) -;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270 ;;; 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." ;; "Invalid search bound (wrong side of point)" ;; error in the subsequent re-search. Maybe ;; another fix would be needed (2007-12-08). - (or (<= (- (cdr c-lit-limits) 2) (point)) - (and - (search-forward-regexp - (concat "\\=[ \t]*\\(" c-current-comment-prefix "\\)") - (- (cdr c-lit-limits) 2) t) - (not (search-forward-regexp - "\\(\\s \\|\\sw\\)" - (- (cdr c-lit-limits) 2) 'limit)) - ;; The comment ender IS on its own line. Exclude - ;; this line from the filling. - (set-marker end (c-point 'bol))))) +; (or (<= (- (cdr c-lit-limits) 2) (point)) +; 2010-10-17 Construct removed. +; (or (< (- (cdr c-lit-limits) 2) (point)) + (and + (search-forward-regexp + (concat "\\=[ \t]*\\(" c-current-comment-prefix "\\)") + (- (cdr c-lit-limits) 2) t) + (not (search-forward-regexp + "\\(\\s \\|\\sw\\)" + (- (cdr c-lit-limits) 2) 'limit)) + ;; The comment ender IS on its own line. Exclude this + ;; line from the filling. + (set-marker end (c-point 'bol))));) ;; The comment ender is hanging. Replace all space between it ;; 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." ;; Start of containing declaration (if any); limit for searching ;; backwards for it. decl-start decl-search-lim + ;; Start of containing declaration (if any); limit for searching + ;; backwards for it. + decl-start decl-search-lim ;; The result from `c-forward-decl-or-cast-1'. decl-or-cast ;; 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." nil))) +(defun c-font-lock-enum-tail (limit) + ;; Fontify an enum's identifiers when POINT is within the enum's brace + ;; block. + ;; + ;; This function will be called from font-lock for a region bounded by POINT + ;; and LIMIT, as though it were to identify a keyword for + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; Fontification". + ;; + ;; Note that this function won't attempt to fontify beyond the end of the + ;; current enum block, if any. + (let* ((paren-state (c-parse-state)) + (encl-pos (c-most-enclosing-brace paren-state)) + (start (point)) + ) + (when (and + encl-pos + (eq (char-after encl-pos) ?\{) + (save-excursion + (goto-char encl-pos) + (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward) + (or (looking-at c-brace-list-key) ; "enum" + (progn (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward) + (looking-at c-brace-list-key))))) + (c-syntactic-skip-backward "^{," nil t) + (c-put-char-property (1- (point)) 'c-type 'c-decl-id-start) + + (c-forward-syntactic-ws) + (c-font-lock-declarators limit t nil))) + nil) + (c-lang-defconst c-simple-decl-matchers "Simple font lock matchers for types and declarations. These are used on 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'." generic casts and declarations are fontified. Used on level 2 and higher." - t `(;; Fontify the identifiers inside enum lists. (The enum type + t `(,@(when (c-lang-const c-brace-id-list-kwds) + ;; Fontify the remaining identifiers inside an enum list when we start + ;; inside it. + `(c-font-lock-enum-tail + ;; Fontify the identifiers inside enum lists. (The enum type ;; name is handled by `c-simple-decl-matchers' or ;; `c-complex-decl-matchers' below. - ,@(when (c-lang-const c-brace-id-list-kwds) - `((,(c-make-font-lock-search-function + (,(c-make-font-lock-search-function (concat "\\<\\(" (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." ;; (fundesc (atom "=" atom)) )) -(defconst octave-smie-closer-alist - (smie-bnf-closer-alist octave-smie-bnf-table)) - (defconst octave-smie-op-levels (smie-prec2-levels (smie-merge-prec2s @@ -521,15 +518,18 @@ Non-nil means always go to the next Octave code line after sending." (t (smie-default-forward-token)))) -(defconst octave-smie-indent-rules - '((";" - (:parent ("function" "if" "while" "else" "elseif" "for" "otherwise" - "case" "try" "catch" "unwind_protect" "unwind_protect_cleanup") - ;; FIXME: don't hardcode 2. - (+ parent octave-block-offset)) - ;; (:parent "switch" 4) ;For (invalid) code between switch and case. - 0) - ((:before . "case") octave-block-offset))) +(defun octave-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) octave-block-offset) + (`(:before . "case") octave-block-offset) + (`(:after . ";") + (if (smie-parent-p "function" "if" "while" "else" "elseif" "for" + "otherwise" "case" "try" "catch" "unwind_protect" + "unwind_protect_cleanup") + '(+ parent octave-block-offset) + ;; For (invalid) code between switch and case. + ;; (if (smie-parent-p "switch") 4) + 0)))) (defvar electric-indent-chars) @@ -619,32 +619,15 @@ already added. You just need to add a description of the problem, including a reproducible test case and send the message." (setq local-abbrev-table octave-abbrev-table) - (smie-setup octave-smie-op-levels octave-smie-indent-rules) + (smie-setup octave-smie-op-levels #'octave-smie-rules + :forward-token #'octave-smie-forward-token + :backward-token #'octave-smie-backward-token) (set (make-local-variable 'smie-indent-basic) 'octave-block-offset) - (set (make-local-variable 'smie-backward-token-function) - 'octave-smie-backward-token) - (set (make-local-variable 'smie-forward-token-function) - 'octave-smie-forward-token) - (set (make-local-variable 'forward-sexp-function) - 'smie-forward-sexp-command) - (set (make-local-variable 'smie-closer-alist) octave-smie-closer-alist) - ;; Only needed for interactive calls to blink-matching-open. - (set (make-local-variable 'blink-matching-check-function) - #'smie-blink-matching-check) - - (when octave-blink-matching-block - (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local) + (set (make-local-variable 'smie-blink-matching-triggers) - (append smie-blink-matching-triggers '(\;) - ;; Rather than wait for SPC or ; to blink, try to blink as - ;; soon as we type the last char of a block ender. - ;; But strip ?d from this list so that we don't blink twice - ;; when the user writes "endif" (once at "end" and another - ;; time at "endif"). - (delq ?d (delete-dups - (mapcar (lambda (kw) - (aref (cdr kw) (1- (length (cdr kw))))) - smie-closer-alist)))))) + (cons ?\; smie-blink-matching-triggers)) + (unless octave-blink-matching-block + (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)) (set (make-local-variable 'electric-indent-chars) (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." ) "Precedence levels of infix operators.") -(defconst prolog-smie-indent-rules - '((":-") - ("->")) - "Prolog indentation rules.") +(defun prolog-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) prolog-indent-width) + (`(:after . ".") 0) ;; To work around smie-closer-alist. + (`(:after . ,(or `":-" `"->")) prolog-indent-width))) (defun prolog-mode-variables () (make-local-variable 'paragraph-separate) @@ -185,19 +186,17 @@ When nil, send actual operating system end of file." (setq paragraph-ignore-fill-prefix t) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression '((nil "^\\sw+" 0))) - (smie-setup prolog-smie-op-levels prolog-smie-indent-rules) - (set (make-local-variable 'smie-forward-token-function) - #'prolog-smie-forward-token) - (set (make-local-variable 'smie-backward-token-function) - #'prolog-smie-backward-token) - (set (make-local-variable 'forward-sexp-function) - 'smie-forward-sexp-command) - (set (make-local-variable 'smie-indent-basic) prolog-indent-width) + + ;; Setup SMIE. + (smie-setup prolog-smie-op-levels #'prolog-smie-rules + :forward-token #'prolog-smie-forward-token + :backward-token #'prolog-smie-backward-token) (set (make-local-variable 'smie-blink-matching-triggers) '(?.)) (set (make-local-variable 'smie-closer-alist) '((t . "."))) (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local) ;; There's no real closer in Prolog anyway. (set (make-local-variable 'smie-blink-matching-inners) t) + (make-local-variable 'comment-start) (setq comment-start "%") (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 @@ ;;; ruby-mode.el --- Major mode for editing Ruby files -;; Copyright (C) 1994, 1995, 1996 1997, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Copyright (C) 1994, 1995, 1996 1997, 1998, 1999, 2000, 2001, 2002, +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. ;; Authors: Yukihiro Matsumoto @@ -1108,6 +1108,8 @@ See `add-log-current-defun-function'." (if mlist (concat mlist mname) mname) mlist))))) +(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit)) + (if (eval-when-compile (fboundp #'syntax-propertize-rules)) ;; New code that works independently from font-lock. (progn @@ -1162,7 +1164,7 @@ See `add-log-current-defun-function'." ;; inf-loop. (if (< (point) start) (goto-char start)))))) ) - + ;; For Emacsen where syntax-propertize-rules is not (yet) available, ;; fallback on the old font-lock-syntactic-keywords stuff. @@ -1478,5 +1480,4 @@ The variable `ruby-indent-level' controls the amount of indentation. (provide 'ruby-mode) -;; arch-tag: e6ecc893-8005-420c-b7f9-34ab99a1fff9 ;;; 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 @@ ;; Maintainer: Michael Mauger <mmaug@yahoo.com> ;; Version: 2.8 ;; Keywords: comm languages processes -;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el +;; URL: http://savannah.gnu.org/projects/emacs/ +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode ;; This file is part of GNU Emacs. @@ -4270,6 +4271,5 @@ buffer. (provide 'sql) -;; arch-tag: 7e1fa1c4-9ca2-402e-87d2-83a5eccb7ac3 ;;; sql.el ends here 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.") (declare-function x-get-selection-internal "xselect.c" (selection-symbol target-type &optional time-stamp)) -;; This is for temporary compatibility with pre-release Emacs 19. -(defalias 'x-selection 'x-get-selection) +;; Only declared obsolete in 23.3. +(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34") + (defun x-get-selection (&optional type data-type) "Return the value of an X Windows selection. The 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 @@ ;;; simple.el --- basic editing commands for Emacs -;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -4051,29 +4051,8 @@ Invoke \\[apropos-documentation] and type \"transient\" or \"mark.*active\" at the prompt, to see the documentation of commands which are sensitive to the Transient Mark mode." :global t - :init-value (not noninteractive) - :initialize 'custom-initialize-delay - :group 'editing-basics) - -;; The variable transient-mark-mode is ugly: it can take on special -;; values. Document these here. -(defvar transient-mark-mode t - "*Non-nil if Transient Mark mode is enabled. -See the command `transient-mark-mode' for a description of this minor mode. - -Non-nil also enables highlighting of the region whenever the mark is active. -The variable `highlight-nonselected-windows' controls whether to highlight -all windows or just the selected window. - -If the value is `lambda', that enables Transient Mark mode temporarily. -After any subsequent action that would normally deactivate the mark -\(such as buffer modification), Transient Mark mode is turned off. - -If the value is (only . OLDVAL), that enables Transient Mark mode -temporarily. After any subsequent point motion command that is not -shift-translated, or any other action that would normally deactivate -the mark (such as buffer modification), the value of -`transient-mark-mode' is set to OLDVAL.") + ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. + :variable transient-mark-mode) (defvar widen-automatically t "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 @@ ;;; speedbar --- quick access to files and tags in a frame ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: file, tags, tools @@ -1128,9 +1129,9 @@ in the selected file. (setq font-lock-keywords nil) ;; no font-locking please (setq truncate-lines t) (make-local-variable 'frame-title-format) - (setq frame-title-format (concat "Speedbar " speedbar-version)) - (setq case-fold-search nil) - (toggle-read-only 1) + (setq frame-title-format (concat "Speedbar " speedbar-version) + case-fold-search nil + buffer-read-only t) (speedbar-set-mode-line-format) ;; Add in our dframe hooks. (if speedbar-track-mouse-flag @@ -4142,5 +4143,4 @@ TEXT is the buffer's name, TOKEN and INDENT are unused." ;; run load-time hooks (run-hooks 'speedbar-load-hook) -;; arch-tag: 4477e6d1-f78c-48b9-a503-387d3c9767d5 ;;; 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 @@ ;;; startup.el --- process Emacs shell arguments -;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -691,6 +691,9 @@ opening the first frame (e.g. open a connection to an X server).") (defvar server-name) (defvar server-process) +;; Autoload in package.el, but when we bootstrap, we don't have loaddefs yet. +(defvar package-enable-at-startup) +(declare-function package-initialize "package" ()) (defun command-line () (setq before-init-time (current-time) @@ -1172,8 +1175,30 @@ the `--debug-init' option to view a complete error backtrace." (eq face-ignored-fonts old-face-ignored-fonts)) (clear-face-cache))) - ;; Load ELPA packages. - (and user-init-file package-enable-at-startup (package-initialize)) + ;; If any package directory exists, initialize the package system. + (and user-init-file + package-enable-at-startup + (catch 'package-dir-found + (let (dirs) + (if (boundp 'package-directory-list) + (setq dirs package-directory-list) + (dolist (f load-path) + (and (stringp f) + (equal (file-name-nondirectory f) "site-lisp") + (push (expand-file-name "elpa" f) dirs)))) + (push (if (boundp 'package-user-dir) + package-user-dir + (locate-user-emacs-file "elpa")) + dirs) + (dolist (dir dirs) + (when (file-directory-p dir) + (dolist (subdir (directory-files dir)) + (when (and (file-directory-p (expand-file-name subdir dir)) + ;; package-subdirectory-regexp from package.el + (string-match "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" + subdir)) + (throw 'package-dir-found t))))))) + (package-initialize)) (setq after-init-time (current-time)) (run-hooks 'after-init-hook) @@ -2359,5 +2384,4 @@ A fancy display is used on graphic displays, normal otherwise." (setq file (replace-match "/" t t file))) file)) -;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db ;;; 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 @@ ("white" 15 65535 65535 65535)) "A list of VGA console colors, their indices and 16-bit RGB values.") -(declare-function x-setup-function-keys "w32-fns" (frame)) +(declare-function x-setup-function-keys "term/common-win" (frame)) (defun terminal-init-w32console () "Terminal initialization function for w32 console." @@ -62,4 +62,4 @@ (tty-set-up-initial-frame-faces) (run-hooks 'terminal-init-w32-hook)) -;; arch-tag: 3195fd5e-ab86-4a46-b1dc-4f7a8c8deff3 +;;; 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: (setq interprogram-cut-function 'x-select-text) (setq interprogram-paste-function 'x-selection-value) +;; Make paste from other applications use the decoding in x-select-request-type +;; and not just STRING. +(defun x-get-selection-value () + "Get the current value of the PRIMARY selection. +Request data types in the order specified by `x-select-request-type'." + (x-selection-value-internal 'PRIMARY)) + (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (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 @@ ;;; bibtex.el --- BibTeX mode for GNU Emacs ;; Copyright (C) 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> ;; Bengt Martensson <bengt@mathematik.uni-Bremen.de> @@ -3835,16 +3836,16 @@ Return t if test was successful, nil otherwise." (with-current-buffer (get-buffer-create err-buf) (setq default-directory dir) (unless (eq major-mode 'compilation-mode) (compilation-mode)) - (toggle-read-only -1) - (delete-region (point-min) (point-max)) - (insert "BibTeX mode command `bibtex-validate'\n" - (if syntax-error - "Maybe undetected errors due to syntax errors. Correct and validate again.\n" - "\n")) - (dolist (err error-list) - (insert (format "%s:%d: %s\n" file (car err) (cdr err)))) - (set-buffer-modified-p nil) - (toggle-read-only 1) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert "BibTeX mode command `bibtex-validate'\n" + (if syntax-error + "Maybe undetected errors due to syntax errors. \ +Correct and validate again.\n" + "\n")) + (dolist (err error-list) + (insert (format "%s:%d: %s\n" file (car err) (cdr err)))) + (set-buffer-modified-p nil)) (goto-char (point-min)) (forward-line 2)) ; first error message (display-buffer err-buf) @@ -3896,12 +3897,11 @@ Return t if test was successful, nil otherwise." (let ((err-buf "*BibTeX validation errors*")) (with-current-buffer (get-buffer-create err-buf) (unless (eq major-mode 'compilation-mode) (compilation-mode)) - (toggle-read-only -1) - (delete-region (point-min) (point-max)) - (insert "BibTeX mode command `bibtex-validate-globally'\n\n") - (dolist (err (sort error-list 'string-lessp)) (insert err)) - (set-buffer-modified-p nil) - (toggle-read-only 1) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert "BibTeX mode command `bibtex-validate-globally'\n\n") + (dolist (err (sort error-list 'string-lessp)) (insert err)) + (set-buffer-modified-p nil)) (goto-char (point-min)) (forward-line 2)) ; first error message (display-buffer err-buf) @@ -4778,5 +4778,4 @@ Return the URL or nil if none can be generated." (provide 'bibtex) -;; arch-tag: ee2be3af-caad-427f-b42a-d20fad630d04 ;;; 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 @@ ;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 ;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Ken Stevens <k.stevens@ieee.org> ;; Maintainer: Ken Stevens <k.stevens@ieee.org> @@ -3896,6 +3897,9 @@ Both should not be used to define a buffer-local dictionary." ;;; returns optionally adjusted region-end-point. +;; If comment-padright is defined, newcomment must be loaded. +(declare-function comment-add "newcomment" (arg)) + (defun ispell-add-per-file-word-list (word) "Add WORD to the per-file word list." (or ispell-buffer-local-name @@ -3970,5 +3974,4 @@ Both should not be used to define a buffer-local dictionary." ; LocalWords: uuencoded unidiff sc nn VM SGML eval IspellPersDict unsplitable ; LocalWords: lns XEmacs HTML casechars Multibyte -;; arch-tag: 4941b9f9-3b7c-4a76-a4ed-5fa8b6010ef5 ;;; 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 @@ ;;; tool-bar.el --- setting up the tool bar -;; -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. -;; + +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. + ;; Author: Dave Love <fx@gnu.org> ;; Keywords: mouse frames ;; Package: emacs @@ -51,8 +51,8 @@ See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for conveniently adding tool bar items." :init-value t :global t - :group 'mouse - :group 'frames + ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. + :variable tool-bar-mode (let ((val (if tool-bar-mode 1 0))) (dolist (frame (frame-list)) (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." :initialize 'custom-initialize-default :set (lambda (sym val) (set-default sym val) - (modify-all-frames-parameters + (modify-all-frames-parameters (list (cons 'tool-bar-position val)))))) (provide 'tool-bar) -;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f + ;;; 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. Optional arg BUFFER-FILE overrides `buffer-file-name'." ;; If we are called from a diff, first switch to the source buffer; ;; in order to respect buffer-local settings of change-log-default-name, etc. - (with-current-buffer (let ((buff (if (eq major-mode 'diff-mode) + (with-current-buffer (let ((buff (if (derived-mode-p 'diff-mode) (car (ignore-errors (diff-find-source-location)))))) (if (buffer-live-p buff) buff @@ -1180,7 +1180,7 @@ Has a preference of looking backwards." ((apply 'derived-mode-p add-log-c-like-modes) (or (c-cpp-define-name) (c-defun-name))) - ((memq major-mode add-log-tex-like-modes) + ((apply #'derived-mode-p add-log-tex-like-modes) (if (re-search-backward "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" 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) where REGEXP should match the expression referring to a bug number in the text, and REPLACEMENT is an expression to pass to `replace-match' to build the Fixes: header.") +(put 'log-edit-rewrite-fixes 'safe-local-variable + (lambda (v) (and (stringp (car-safe v)) (stringp (cdr v))))) (defun log-edit-insert-changelog (&optional use-first) "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 (message "There are unresolved conflicts in %s" (file-name-nondirectory rej)))))) -(defun vc-arch-checkin (files rev comment &optional extra-args-ignored) +(defun vc-arch-checkin (files rev comment) (if rev (error "Committing to a specific revision is unsupported")) ;; FIXME: This implementation probably only works for singleton filesets (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." (directory-file-name dir)))) (eq dir t))) -(defun vc-cvs-checkin (files rev comment &optional extra-args-ignored) +(defun vc-cvs-checkin (files rev comment) "CVS-specific version of `vc-backend-checkin'." (unless (or (not rev) (vc-cvs-valid-revision-number-p rev)) (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." (declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-mtn-checkin (files rev comment &optional extra-args-ignored) +(defun vc-mtn-checkin (files rev comment) (apply 'vc-mtn-command nil 0 files (nconc (list "commit" "-m") (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." (yes-or-no-p (format "Directory %s is empty; remove it? " dir)) (delete-directory dir)))) -(defun vc-rcs-checkin (files rev comment &optional extra-args-ignored) +(defun vc-rcs-checkin (files rev comment) "RCS-specific version of `vc-backend-checkin'." (let ((switches (vc-switches 'RCS 'checkin))) ;; 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." (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "") (file-name-nondirectory file))))) -(defun vc-sccs-checkin (files rev comment &optional extra-args-ignored) +(defun vc-sccs-checkin (files rev comment) "SCCS-specific version of `vc-backend-checkin'." (dolist (file (vc-expand-dirs files)) (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 @@ * nsterm.m (ns_draw_glyph_string): Handle the case GLYPHLESS_GLYPH (the detail is not yet implemented). +2010-10-31 Glenn Morris <rgm@gnu.org> + + * xterm.c (x_connection_closed) [USE_X_TOOLKIT]: Fix merge, maybe. + + * frame.c (syms_of_frame) <tool-bar-mode>: + Default to nil if !HAVE_WINDOW_SYSTEM. (Bug#7299) + +2010-10-31 Chong Yidong <cyd@stupidchicken.com> + + * xterm.c (x_connection_closed): Print informative error message + when aborting on GTK. This requires using shut_down_emacs + directly instead of Fkill_emacs. + +2010-10-31 Michael Albinus <michael.albinus@gmx.de> + + * dbusbind.c (Fdbus_call_method_asynchronously) + (Fdbus_register_signal, Fdbus_register_method): Check, whether + `dbus-registered-objects-table' is initialized. + +2010-10-29 Eli Zaretskii <eliz@gnu.org> + + * emacs.c (main): Call syms_of_filelock unconditionally. + + * filelock.c (syms_of_filelock): Move out of #ifdef CLASH_DETECTION + clause, but keep part of it conditioned on CLASH_DETECTION. + +2010-10-29 Glenn Morris <rgm@gnu.org> + + * nsfns.m (Fx-display-save-under, Fx-open-connection) + (Fxw-color-defined-p, Fxw-display-color-p, Fx-show-tip): + * w32fns.c (Fxw_color_defined_p, Fx_open_connection): + * xfns.c (Fxw_color_defined_p, Fx_open_connection): + Sync docs between X, W32, NS. + + * buffer.c (syms_of_buffer) <abbrev-mode, transient-mark-mode>: + * frame.c (syms_of_frame) <tool-bar-mode>: Move doc here from Lisp. + 2010-10-26 Juanma Barranquero <lekktu@gmail.com> * 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. */); doc: /* Local (mode-specific) abbrev table of current buffer. */); DEFVAR_PER_BUFFER ("abbrev-mode", ¤t_buffer->abbrev_mode, Qnil, - doc: /* Non-nil turns on automatic expansion of abbrevs as they are inserted. */); + doc: /* Non-nil if Abbrev mode is enabled. +Use the command `abbrev-mode' to change this variable. */); DEFVAR_PER_BUFFER ("case-fold-search", ¤t_buffer->case_fold_search, Qnil, @@ -6098,11 +6099,23 @@ to the value obtained by calling `current-time'. If the buffer has never been shown in a window, the value is nil. */); DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode, - doc: /* */); + doc: /* Non-nil if Transient Mark mode is enabled. +See the command `transient-mark-mode' for a description of this minor mode. + +Non-nil also enables highlighting of the region whenever the mark is active. +The variable `highlight-nonselected-windows' controls whether to highlight +all windows or just the selected window. + +If the value is `lambda', that enables Transient Mark mode temporarily. +After any subsequent action that would normally deactivate the mark +\(such as buffer modification), Transient Mark mode is turned off. + +If the value is (only . OLDVAL), that enables Transient Mark mode +temporarily. After any subsequent point motion command that is not +shift-translated, or any other action that would normally deactivate +the mark (such as buffer modification), the value of +`transient-mark-mode' is set to OLDVAL. */); Vtransient_mark_mode = Qnil; - /* The docstring is in simple.el. If we put it here, it would be - overwritten when transient-mark-mode is defined using - define-minor-mode. */ DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only, 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 SDATA (interface), SDATA (method)); + /* Check dbus-registered-objects-table. */ + if (!HASH_TABLE_P (Vdbus_registered_objects_table)) + XD_SIGNAL1 (build_string ("dbus.el is not loaded")); + /* Open a connection to the bus. */ connection = xd_initialize (bus, TRUE); @@ -1869,6 +1873,10 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG wrong_type_argument (intern ("functionp"), handler); GCPRO6 (bus, service, path, interface, signal, handler); + /* Check dbus-registered-objects-table. */ + if (!HASH_TABLE_P (Vdbus_registered_objects_table)) + XD_SIGNAL1 (build_string ("dbus.el is not loaded")); + /* Retrieve unique name of service. If service is a known name, we will register for the corresponding unique name, if any. Signals are sent always with the unique name as sender. Note: the unique @@ -1981,6 +1989,10 @@ used for composing the returning D-Bus message. */) /* TODO: We must check for a valid service name, otherwise there is a segmentation fault. */ + /* Check dbus-registered-objects-table. */ + if (!HASH_TABLE_P (Vdbus_registered_objects_table)) + XD_SIGNAL1 (build_string ("dbus.el is not loaded")); + /* Open a connection to the bus. */ connection = xd_initialize (bus, TRUE); 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) syms_of_doc (); syms_of_editfns (); syms_of_emacs (); -#ifdef CLASH_DETECTION syms_of_filelock (); -#endif /* CLASH_DETECTION */ syms_of_indent (); syms_of_insdel (); /* 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) boot_time_initialized = 0; } +#endif /* CLASH_DETECTION */ + void syms_of_filelock (void) { @@ -737,12 +739,12 @@ syms_of_filelock (void) doc: /* The directory for writing temporary files. */); Vtemporary_file_directory = Qnil; +#ifdef CLASH_DETECTION defsubr (&Sunlock_buffer); defsubr (&Slock_buffer); defsubr (&Sfile_locked_p); +#endif } -#endif /* CLASH_DETECTION */ - /* arch-tag: e062676d-50b2-4be0-ab96-197c81b181a1 (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'. */); Vmenu_bar_mode = Qt; DEFVAR_LISP ("tool-bar-mode", &Vtool_bar_mode, - doc: /* Non-nil if Tool-Bar mode is enabled. */); + doc: /* Non-nil if Tool-Bar mode is enabled. +See the command `tool-bar-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `tool-bar-mode'. */); +#ifdef HAVE_WINDOW_SYSTEM Vtool_bar_mode = Qt; +#else + Vtool_bar_mode = Qnil; +#endif DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame, 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 @@ /* Functions for the NeXT/Open/GNUstep and MacOSX window system. - Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009, 2010 - Free Software Foundation, Inc. + +Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -1697,7 +1698,7 @@ If omitted or nil, the selected frame's display is used. */) DEFUN ("x-display-save-under", Fx_display_save_under, Sx_display_save_under, 0, 1, 0, - doc: /* Non-nil if the Nextstep display server supports the save-under feature. + doc: /* Return t if DISPLAY supports the save-under feature. The optional argument DISPLAY specifies which display to ask about. DISPLAY should be a frame, the display name as a string, or a terminal ID. If 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. */) DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 0, - doc: /* Open a connection to a Nextstep display server. + doc: /* Open a connection to a display server. DISPLAY is the name of the display to connect to. -Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored. */) +Optional second arg XRM-STRING is a string of resources in xrdb format. +If the optional third arg MUST-SUCCEED is non-nil, +terminate Emacs if we can't open the connection. +\(In the Nextstep version, the last two arguments are currently ignored.) */) (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) { struct ns_display_info *dpyinfo; @@ -2201,8 +2205,8 @@ x_sync (struct frame *f) DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Return t if the current Nextstep display supports the color COLOR. -The optional argument FRAME is currently ignored. */) + doc: /* Internal function called by `color-defined-p', which see. +\(Note that the Nextstep version of this function ignores FRAME.) */) (Lisp_Object color, Lisp_Object frame) { NSColor * col; @@ -2233,10 +2237,7 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, - doc: /* Return t if the Nextstep display supports color. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame, a display name (a string), or terminal ID. -If omitted or nil, that stands for the selected frame's display. */) + doc: /* Internal function called by `display-color-p', which see. */) (Lisp_Object display) { NSWindowDepth depth; @@ -2430,6 +2431,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, doc: /* Show STRING in a \"tooltip\" window on frame FRAME. A tooltip window is a small window displaying a string. +This is an internal function; Lisp code should call `tooltip-show'. + FRAME nil or omitted means use the selected frame. PARMS 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. */); } -// 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, DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Internal function called by `color-defined-p', which see. */) + doc: /* Internal function called by `color-defined-p', which see. +\(Note that the Nextstep version of this function ignores FRAME.) */) (Lisp_Object color, Lisp_Object frame) { XColor foo; @@ -4851,11 +4852,12 @@ x_display_info_for_name (Lisp_Object name) } DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, - 1, 3, 0, doc: /* Open a connection to a server. + 1, 3, 0, doc: /* Open a connection to a display server. DISPLAY is the name of the display to connect to. Optional second arg XRM-STRING is a string of resources in xrdb format. If the optional third arg MUST-SUCCEED is non-nil, -terminate Emacs if we can't open the connection. */) +terminate Emacs if we can't open the connection. +\(In the Nextstep version, the last two arguments are currently ignored.) */) (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed) { unsigned char *xrm_option; @@ -7267,5 +7269,3 @@ w32_last_error (void) return GetLastError (); } -/* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446 - (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. */) DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Internal function called by `color-defined-p', which see. */) + doc: /* Internal function called by `color-defined-p', which see +.\(Note that the Nextstep version of this function ignores FRAME.) */) (Lisp_Object color, Lisp_Object frame) { XColor foo; @@ -4099,11 +4100,12 @@ x_display_info_for_name (Lisp_Object name) DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 0, - doc: /* Open a connection to an X server. + doc: /* Open a connection to a display server. DISPLAY is the name of the display to connect to. Optional second arg XRM-STRING is a string of resources in xrdb format. If the optional third arg MUST-SUCCEED is non-nil, -terminate Emacs if we can't open the connection. */) +terminate Emacs if we can't open the connection. +\(In the Nextstep version, the last two arguments are currently ignored.) */) (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed) { 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) delete_frame (frame, Qnoelisp); } - /* We have to close the display to inform Xt that it doesn't - exist anymore. If we don't, Xt will continue to wait for - events from the display. As a consequence, a sequence of - - M-x make-frame-on-display RET :1 RET - ...kill the new frame, so that we get an IO error... - M-x make-frame-on-display RET :1 RET - - will indefinitely wait in Xt for events for display `:1', opened - in the first call to make-frame-on-display. - - Closing the display is reported to lead to a bus error on - OpenWindows in certain situations. I suspect that is a bug - in OpenWindows. I don't know how to circumvent it here. */ - + /* If DPYINFO is null, this means we didn't open the display in the + first place, so don't try to close it. */ if (dpyinfo) { #ifdef USE_X_TOOLKIT - /* If DPYINFO is null, this means we didn't open the display - in the first place, so don't try to close it. */ - { - fatal_error_signal_hook = x_fatal_error_signal; - XtCloseDisplay (dpy); - fatal_error_signal_hook = NULL; - } -#endif + /* We have to close the display to inform Xt that it doesn't + exist anymore. If we don't, Xt will continue to wait for + events from the display. As a consequence, a sequence of + + M-x make-frame-on-display RET :1 RET + ...kill the new frame, so that we get an IO error... + M-x make-frame-on-display RET :1 RET + + will indefinitely wait in Xt for events for display `:1', + opened in the first call to make-frame-on-display. + + Closing the display is reported to lead to a bus error on + OpenWindows in certain situations. I suspect that is a bug + in OpenWindows. I don't know how to circumvent it here. */ + fatal_error_signal_hook = x_fatal_error_signal; + XtCloseDisplay (dpy); + fatal_error_signal_hook = NULL; +#endif /* USE_X_TOOLKIT */ #ifdef USE_GTK - /* There is a long-standing bug in GTK that prevents the GTK - main loop from recovering gracefully from disconnects - (https://bugzilla.gnome.org/show_bug.cgi?id=85715). Among - other problems, this gives rise to a stream of Glib error - messages that, in one incident, filled up a user's hard disk - (http://lists.gnu.org/archive/html/emacs-devel/2010-10/msg00927.html). - So, kill Emacs unconditionally if the display is closed. */ - { - fprintf (stderr, "%s\n", error_msg); - Fkill_emacs (make_number (70)); - abort (); /* NOTREACHED */ - } -#endif + /* A long-standing GTK bug prevents proper disconnect handling + (https://bugzilla.gnome.org/show_bug.cgi?id=85715). Once, + the resulting Glib error message loop filled a user's disk. + To avoid this, kill Emacs unconditionally on disconnect. */ + shut_down_emacs (0, 0, Qnil); + fprintf (stderr, "%s\n\ +When compiled with GTK, Emacs cannot recover from X disconnects.\n\ +This is a GTK bug: https://bugzilla.gnome.org/show_bug.cgi?id=85715\n\ +For details, see etc/PROBLEMS.\n", + error_msg); + abort (); +#endif /* USE_GTK */ /* Indicate that this display is dead. */ dpyinfo->display = 0; |