Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-20 03:47:34 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merged in changes from CVS trunk.

Browse source 
Patches applied:

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-653
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-654
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-655
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-656
   Update from CVS: lisp/man.el (Man-xref-normal-file): Fix help-echo.

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-657
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-658
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-659
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-660
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-661
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-662
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-663
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-664
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-665
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-666
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-667
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-668
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-669
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-670
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-671
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-64
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-65
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-66
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-67
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-68
   Update from CVS

git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-264
This commit is contained in:
Karoly Lorentey 2004-11-06 17:52:02 +00:00
commit 65ea794923
148 changed files with 4158 additions and 1819 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
ChangeLog
View file

@ -1,3 +1,12 @@
2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* configure.in (HAVE_GTK_FILE_CHOOSER, $HAVE_GTK_FILE_SELECTION): New
tests for new and old GTK file dialogs.
(HAVE_GTK): Only set with_toolkit_scroll_bars if not explicitly set
to no.
* configure: Rebuild
2004-10-20 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* configure.in (HAVE_PERSONALITY_LINUX32): New test if PER_LINUX32

4
admin/ChangeLog
View file

@ -1,3 +1,7 @@
2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* FOR-RELEASE (Indications): Remove two stage update for toolbar (Done).
2004-09-20 Luc Teirlinck <teirllm@auburn.edu>
* FOR-RELEASE (Indications): Rearrange checklists for Emacs and

218
admin/FOR-RELEASE
View file

@ -8,6 +8,8 @@ Tasks needed before the next release.
** Face remapping.
** Let mouse-1 follow links.
* FATAL ERRORS
@ -18,12 +20,228 @@ redisplay uses an invalidated face_id with FACE_FROM_ID
which then returns a NULL pointer. Said to happen with
isearch faces.
** Investigate reported crashes in compact_small_strings.
** Investigate reported crashes related to using an
invalid pointer from string_free_list.
* LOSSAGE
** Clean up flymake.el to follow Emacs Lisp conventions.
* GTK RELATED BUGS
** Make GTK scrollbars behave like others w.r.t. overscrolling.
* REDISPLAY RELATED BUGS
** Avoid unbreakable loops in redisplay.
Redisplay may loop if there is an error in some display property, e.g.
(space 'left-margin)
A fix would be to somehow disable handling of display properties if an error
is encountered.
** Problem with cursor border around images and window-margins:
The border around the image when the cursor is on the image
flows into the right fringe and margin.
(progn
(auto-image-file-mode 1)
(find-file (concat data-directory "splash.xpm"))
(set-window-margins (selected-window) 25 25))
** Problem with modeline and window margins:
The mode line's right "box" line is misplaced under the right margin,
rather than at the right window edge.
emacs -Q
(set-window-margins nil 25 25)
C-x 2
** custom mode-line face makes Emacs freeze up
From: Stephen Berman <Stephen.Berman@gmx.net>
Date: Sun, 24 Oct 2004 02:08:56 +0200
1. Start Emacs with -q -no-site-file.
2. Type `M-x customize-face' and at the prompt `mode-line'.
3. In the Custom buffer for mode-line face
a. check width and give it the value `narrow';
b. check height and give it the value 120 in 1/10 pt;
c. check underline and give it the value `on' (or `colored');
d. check overline and give it the value `on' (or `colored').
4. Set for current session.
5. Invoke Ediff on any two files.
6. Now Emacs is frozen and consumes 95-99% of CPU.
The customizations in step 3 appear to be the minimum necessary to
induce this bug. Leave out any one of them and Ediff runs without a
problem. Also if the 1/10 point value of height is 130 or greater
there's no bug (with the default font family; with e.g. Helvetica the
bug is induced only by a value of 100 or less).
I've noticed this freeze up only when invoking Ediff. The only thing
I've been able to do is kill Emacs externally, via top or with kill
when run in gdb, after interrupting. When the freeze up happens
within a gdb session, there is no automatic debugging feedback. After
interrupting I can get a backtrace, here's an example:
Update: Maybe only reveals itself when compiled with GTK+
** Mouse-face overlay bleeds into header line
From: Stephen Berman <Stephen.Berman@gmx.net>
Date: Thu, 21 Oct 2004 18:11:01 +0200
Mouse-face overlays bleed into the header line when the beginning of
the overlay is above (point-min). To reproduce:
1. Start Emacs with -q -no-site-file.
2. In *scratch* eval (setq ov (make-overlay 66 92)), (overlay-put ov
'mouse-face 'highlight), and (setq header-line-format "test").
3. Drag the mouse over the string "evaluation.\n;; If you want" and
notice the highlighting of only this string.
4. Now click on the down arrow in the scroll bar until the line
beginning ";; If you want" is directly below the header line.
5. Drag the mouse over ";; If you want" and notice that not only it
but also the header line are highlighted.
** scroll-preserve-screen-position doesn't work with a header-line-format
From: jbyler+emacs-lists@anon41.eml.cc
Date: Tue, 17 Aug 2004 17:10:14 -0400
There seems to be an off-by-one error triggered by using a header line
together with scroll-preserve-screen-position. The symptom: instead of
staying in the same position on the screen when scrolling, the cursor
moves one screen line down each time the buffer is scrolled. Put
another way: repeatedly typing C-v M-v or using a mouse scroll wheel to
scroll up and down causes the cursor to migrate slowly down the screen
instead of staying put as it should.
To reproduce:
emacs -q --no-site-file
(setq scroll-preserve-screen-position t)
(setq header-line-format "")
C-v M-v C-v M-v C-v M-v etc.
** Clicking on partially visible lines fails
From: David Kastrup <dak@gnu.org>
Date: 27 Apr 2004 16:42:58 +0200
I had gnus display a mouse-highlighted line (a URL from browse-url)
partially at the bottom of its window. If I click with middle mouse
key on it, the window gets recentered while I hold the mouse key
pressed. If I release it, the window returns into its old position
(cursor in top row) and nothing happens, presumably because the click
was not registered on the line itself, but on the magically
recentered version.
That is a nuisance. Recentering of even partially visible click
targets should only happen if window-point moves there, but not at
the time of the click. From the moment I hold down a key until it
gets released, the displayed window portion should not change, with
the sole exception of scrolling when dragging at the edge of the
screen.
** Can't drag modeline when mouse-autoselect-window is set
From: Klaus Zeitler <kzeitler@lucent.com>
Date: Mon, 11 Oct 2004 11:14:49 +0200
1. start emacs -q --no-site-file
2. set variable mouse-autoselect-window to t
3. split-window-vertically
now I can drag the modeline only upwards but not downwards
** line-spacing and (recenter -1)
From: SAITO Takuya <tabmore@rivo.mediatti.net>
Date: Mon, 31 May 2004 02:07:57 +0900 (JST)
(recenter -1) does not show point at the bottom of the window
if line-spacing is set to positive integer.
Start emacs -Q, and evaluate below:
(progn
(setq line-spacing 1)
(dotimes (i (window-height))
(insert "\n" (int-to-string i)))
(recenter -1))
Then, point is displayed at the center of the window.
But point should be displayed at the bottom of the window like Emacs-21.3.
** line-spacing and garbage in fringe
From: SAITO Takuya <tabmore@rivo.mediatti.net>
Date: Mon, 31 May 2004 02:08:05 +0900 (JST)
Start emacs -Q and evaluate below with C-xC-e:
(let ((lines 2)
(spacing 1))
(setq line-spacing spacing
indicate-buffer-boundaries t)
(insert (make-string (window-height) ?\n))
(goto-char (point-min))
(message (make-string (* (window-width) lines) ?.))
(scroll-up 1))
then, garbage is displayed in right fringe.
Above code reproduces this bug with
(frame-parameter nil 'font)
=> "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1"
If you use different font, you may need different value of
`lines' and/or `spacing'.
** line-spacing and Electric-pop-up-window
From: SAITO Takuya <tabmore@rivo.mediatti.net>
Date: Mon, 31 May 2004 02:08:10 +0900 (JST)
Electric-pop-up-window does not work well
if truncate long lines disabled and/or
`line-spacing' is set to positive integer.
For example, start emacs -Q --line-spacing 1, and type M-` .
Then, the last line of *Completions* buffer is not visible.
fit-window-to-buffer works well for me, so I guess
Electric-pop-up-window can use it.
* DOCUMENTATION
** Finish updating the Emacs Lisp manual.

220
configure vendored
View file

@ -9797,7 +9797,9 @@ _ACEOF
USE_X_TOOLKIT=none
with_toolkit_scroll_bars=yes
if test "$with_toolkit_scroll_bars" != no; then
with_toolkit_scroll_bars=yes
fi
HAVE_GTK_MULTIDISPLAY=no
@ -9906,6 +9908,222 @@ done
cat >>confdefs.h <<\_ACEOF
#define HAVE_GTK_MULTIDISPLAY 1
_ACEOF
fi
HAVE_GTK_FILE_SELECTION=no
for ac_func in gtk_file_selection_new
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
if eval "test \"\${$as_ac_var+set}\" = set"; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
For example, HP-UX 11i <limits.h> declares gettimeofday. */
#define $ac_func innocuous_$ac_func
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func (); below.
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
<limits.h> exists even on freestanding compilers. */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
#undef $ac_func
/* Override any gcc2 internal prototype to avoid an error. */
#ifdef __cplusplus
extern "C"
{
#endif
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char $ac_func ();
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
char (*f) () = $ac_func;
#endif
#ifdef __cplusplus
}
#endif
int
main ()
{
return f != $ac_func;
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
eval "$as_ac_var=yes"
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
eval "$as_ac_var=no"
fi
rm -f conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
if test `eval echo '${'$as_ac_var'}'` = yes; then
cat >>confdefs.h <<_ACEOF
#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
HAVE_GTK_FILE_SELECTION=yes
fi
done
HAVE_GTK_FILE_CHOOSER=no
for ac_func in gtk_file_chooser_dialog_new
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
if eval "test \"\${$as_ac_var+set}\" = set"; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
For example, HP-UX 11i <limits.h> declares gettimeofday. */
#define $ac_func innocuous_$ac_func
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func (); below.
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
<limits.h> exists even on freestanding compilers. */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
#undef $ac_func
/* Override any gcc2 internal prototype to avoid an error. */
#ifdef __cplusplus
extern "C"
{
#endif
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char $ac_func ();
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
char (*f) () = $ac_func;
#endif
#ifdef __cplusplus
}
#endif
int
main ()
{
return f != $ac_func;
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
eval "$as_ac_var=yes"
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
eval "$as_ac_var=no"
fi
rm -f conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
if test `eval echo '${'$as_ac_var'}'` = yes; then
cat >>confdefs.h <<_ACEOF
#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
HAVE_GTK_FILE_CHOOSER=yes
fi
done
if test "$HAVE_GTK_FILE_SELECTION" = yes \
&& test "$HAVE_GTK_FILE_CHOOSER" = yes; then
cat >>confdefs.h <<\_ACEOF
#define HAVE_GTK_FILE_BOTH 1
_ACEOF
fi

19
configure.in
View file

@ -1967,7 +1967,9 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "gtk"; then
dnl GTK scrollbars resemble toolkit scrollbars a lot, so to avoid
dnl a lot if #ifdef:s, say we have toolkit scrollbars.
with_toolkit_scroll_bars=yes
if test "$with_toolkit_scroll_bars" != no; then
with_toolkit_scroll_bars=yes
fi
dnl Check if we can use multiple displays with this GTK version.
dnl If gdk_display_open exists, assume all others are there also.
@ -1977,6 +1979,21 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "gtk"; then
AC_DEFINE(HAVE_GTK_MULTIDISPLAY, 1,
[Define to 1 if GTK can handle more than one display.])
fi
dnl Check if we have the old file selection dialog.
dnl If gdk_display_open exists, assume all others are there also.
HAVE_GTK_FILE_SELECTION=no
AC_CHECK_FUNCS(gtk_file_selection_new, HAVE_GTK_FILE_SELECTION=yes)
dnl Check if we have the new file chooser dialog
dnl If gdk_display_open exists, assume all others are there also.
HAVE_GTK_FILE_CHOOSER=no
AC_CHECK_FUNCS(gtk_file_chooser_dialog_new, HAVE_GTK_FILE_CHOOSER=yes)
if test "$HAVE_GTK_FILE_SELECTION" = yes \
&& test "$HAVE_GTK_FILE_CHOOSER" = yes; then
AC_DEFINE(HAVE_GTK_FILE_BOTH, 1,
[Define to 1 if GTK has both file selection and chooser dialog.])
fi
fi
dnl Do not put whitespace before the #include statements below.

46
etc/NEWS
View file

@ -643,14 +643,17 @@ version 4.7 or newer, compiles to Info pages with embedded images.
** BibTeX mode:
*** The new command bibtex-url browses a URL for the BibTeX entry at
point (bound to C-c C-l and mouse-2 on clickable fields).
point (bound to C-c C-l and mouse-2, RET on clickable fields).
*** The new command bibtex-entry-update (bound to C-c C-u) updates
an existing BibTeX entry.
*** New `bibtex-entry-format' option `required-fields', enabled by default.
*** bibtex-maintain-sorted-entries can take values `plain',
`crossref', and `entry-class' which control the sorting scheme used
for BibTeX entries. `bibtex-sort-entry-class' controls the sorting
scheme `entry-class'. TAB completion for reference keys and
for BibTeX entries. `bibtex-sort-entry-class' controls the sorting
scheme `entry-class'. TAB completion for reference keys and
automatic detection of duplicates does not require anymore that
bibtex-maintain-sorted-entries is non-nil.
@ -667,11 +670,22 @@ types for which fields are filled automatically (if possible).
point according to context (bound to M-tab).
*** The new commands bibtex-find-entry and bibtex-find-crossref
locate entries and crossref'd entries.
locate entries and crossref'd entries. Crossref fields are clickable
(bound to mouse-2, RET).
*** In BibTeX mode the command fill-paragraph (bound to M-q) fills
individual fields of a BibTeX entry.
*** The new command bibtex-validate-globally checks for duplicate keys
in multiple BibTeX files. See also the new variables bibtex-files
and bibtex-file-path.
*** The new command bibtex-find-entry-globally searches BibTeX entries
in multiple BibTeX files.
*** The new command bibtex-copy-summary-as-kill pushes summary
of BibTeX entry to kill ring (bound to C-c C-t).
** When display margins are present in a window, the fringes are now
displayed between the margins and the buffer's text area, rather than
at the edges of the window.
@ -917,15 +931,26 @@ amount of text shown any more (only a crude approximation of it).
---
** The pop up menus for Lucid now stay up if you do a fast click and can
be navigated with the arrow keys (like Gtk+ and W32).
be navigated with the arrow keys (like Gtk+, Mac and W32).
---
** Dialogs for Lucid/Athena and Lesstif/Motif pops down when pressing ESC.
** Dialogs for Lucid/Athena and Lesstif/Motif now pops down when pressing
ESC, like they do for Gtk+, Mac and W32.
---
** The menu item "Open File..." has been split into two items, "New File..."
and "Open File...". "Open File..." now opens only existing files. This is
to support existing GUI file selection dialogs better.
+++
** The file selection dialog for Gtk+, W32 and Motif/Lesstif can be
** The file selection dialog for Gtk+, Mac, W32 and Motif/Lesstif can be
disabled by customizing the variable `use-file-dialog'.
+++
** For Gtk+ version 2.4, you can make Emacs use the old file dialog
by setting the variable `use-old-gtk-file-dialog' to t. Default is to use
the new dialog.
+++
** Emacs can produce an underscore-like (horizontal bar) cursor.
The underscore cursor is set by putting `(cursor-type . hbar)' in
@ -2298,6 +2323,13 @@ configuration files.
* Lisp Changes in Emacs 21.4
+++
** The new function `called-interactively-p' does what many people
have mistakenly believed `interactively-p' did: it returns t if the
calling function was called through `call-interactively'.
This should only be used when you cannot add a new "interactively"
argument to the command.
+++
** An interactive specification may now use the code letter 'U' to get
the up-event that was discarded in case the last key sequence read for a

2
etc/TODO
View file

@ -85,6 +85,8 @@ to the FSF.
at the same time and do it in a context-sensitive way.
*** ability to add mode-specific data to the partial-parse-state.
** Add a way to convert a keyboard macro to equivalent Lisp code.
** Have a command suggestion help system that recognizes patterns
of commands which could be replaced with a simpler common command.
It should not make more than one suggestion per 10 minutes.

351
lisp/ChangeLog
View file

@ -1,7 +1,346 @@
2004-11-05 Juri Linkov <juri@jurta.org>
* info.el (Info-search): Don't search in node header lines
and file headers.
* emacs-lisp/edebug.el (edebug-next-token-class): Allow all
symbol-constituent characters after dot, not only digits.
2004-11-04 Daniel Pfeiffer <occitan@esperanto.org>
* files.el (set-auto-mode): Don't get error after setting
-*-mode-*-.
2004-11-04 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* dired.el (dired-read-dir-and-switches): Call read-directory-name
if a dialog will be used, read-file-name otherwise.
2004-11-04 Richard M. Stallman <rms@gnu.org>
* textmodes/table.el (table group): Add :version.
* textmodes/ispell.el (ispell-word):
Don't alter args; set them only thru `interactive' spec.
* textmodes/flyspell.el (flyspell-word):
Don't alter FOLLOWING; set it only thru `interactive' spec.
* progmodes/f90.el (f90-end-of-block): Don't use interactive-p.
* net/browse-url.el (browse-url-maybe-new-window):
Use called-interactively-p.
* mail/supercite.el (sc-cite-region):
Don't use interactive-p. Add arg INTERACTIVE.
(sc-version): Don't use interactive-p. Rename arg to MESSAGE.
* international/mule-cmds.el (set-input-method, toggle-input-method):
Don't use interactive-p. Add arg INTERACTIVE.
* eshell/esh-mode.el (eshell-show-maximum-output):
Don't use interactive-p.
(eshell-truncate-buffer): Just message, no error, if buffer is short.
* mouse.el (mouse-show-mark): Get positions to delete from mark
and point, not from mouse-drag-overlay.
* imenu.el (imenu-eager-completion-buffer): Add :version.
* filesets.el (filesets group): Add :version.
2004-11-03 Daniel Pfeiffer <occitan@esperanto.org>
* files.el (xml-based-modes): Delete var.
(magic-mode-alist): New more general var.
(set-auto-mode): Use it.
* buff-menu.el (Buffer-menu-make-sort-button): Preserve point even
when clicking from another window.
2004-11-03 Thien-Thi Nguyen <ttn@gnu.org>
* vc-cvs.el (vc-cvs-local-month-numbers): Delete var.
(vc-cvs-annotate-time): Incorporate value of deleted var.
Remove special-case handling of beginning-of-buffer cruft.
Cache ending position (point) and return value in text property
`vc-cvs-annotate-time', and consult it on subsequent invocations.
* vc-cvs.el (vc-cvs-annotate-command):
Delete extraneous lines from beginning of buffer.
* vc-mcvs.el (vc-mcvs-annotate-command): Likewise.
* progmodes/grep.el (grep-default-command): Take empty string
for tag if all other methods yield nil. Shell-quote the tag.
* vc.el (vc-annotate-display-autoscale): Add prefix-arg
spec in `interactive' form, and mention it in the docstring.
Also, make sure point is at bol after calling `annotate-time'.
2004-11-02 Richard M. Stallman <rms@gnu.org>
* cus-edit.el (customize-group-other-window):
Select the window that displays the custom buffer.
(custom-buffer-create-other-window): Likewise.
* comint.el (comint-insert-input): Fix previous change.
* emacs-lisp/elp.el (elp-instrument-function):
Use called-interactively-p.
* emacs-lisp/easymenu.el (easy-menu-intern):
Don't downcase; rather, case-flip the first letter of each word.
* emacs-lisp/easy-mmode.el (define-minor-mode):
Use called-interactively-p.
* emacs-lisp/bytecomp.el (byte-compile-warning-types):
Add interactive-only.
(byte-compile-warnings): Add interactive-only as option.
(byte-compile-interactive-only-functions): New variable.
(byte-compile-form): Warn about calls to functions
in byte-compile-interactive-only-functions.
* emacs-lisp/autoload.el (update-file-autoloads):
Don't use interactive-p; take new arg SAVE-AFTER.
* emacs-lisp/advice.el (ad-make-advised-definition):
Use called-interactively-p.
2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* files.el (find-file-existing): New function.
* menu-bar.el (menu-bar-files-menu): Make "Open File..." call
find-file-existing. Add "New File..." that calls find-file.
* diropen.pbm diropen.xpm: New files.
* toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses
icon diropen. New tool bar item find-file-existing uses icon open.
* dired.el (dired-read-dir-and-switches): Call read-driectory-name
instead of read-file-name.
2004-11-02 Ulf Jasper <ulf.jasper@web.de>
* calendar/icalendar.el (icalendar-version): Increase to 0.08.
(icalendar--split-value): Change name of work buffer.
(icalendar--get-weekday-abbrev): Return nil on error.
(icalendar--date-to-isodate): New function.
(icalendar-convert-diary-to-ical)
(icalendar-extract-ical-from-buffer): Use only two args for
make-obsolete (XEmacs compatibility).
(icalendar-export-file, icalendar-import-file): Blank at end of
prompt.
(icalendar-export-region): Doc fix.
If error, return non-nil and write errors to a buffer.
Use correct weekday for weekly recurring events.
Check whether date has been parsed for ordinary events.
Make weekly events start in the year 2000.
DTEND is non-inclusive, shift end date by one day if
necessary (not for entries that have date and time).
Rename local let variables: oops -> found-error, datestring ->
startdatestring.
2004-11-02 Kim F. Storm <storm@cua.dk>
* files.el (set-auto-mode-0): Don't rely on dynamic binding of
keep-mode-if-same variable. Add it as optional arg instead.
(set-auto-mode): Call set-auto-mode-0 with keep-mode-if-same.
* ehelp.el (electric-help-map): Reorder Q/q and R/r entries so
substitute-command-keys will select lower-case bindings like those
used in the static help texts.
* descr-text.el (describe-text-properties): Don't err if called in
the *Help* buffer; output to *Help-2* buffer instead.
* kmacro.el (group kmacro): Add :version.
(kmacro-keyboard-quit): New function to cleanup on C-g.
(kmacro-start-macro): Set defining-kbd-macro to append when
appending to last macro.
* simple.el (keyboard-quit): Call kmacro-keyboard-quit.
2004-11-02 Nick Roberts <nickrob@snap.net.nz>
* progmodes/gdb-ui.el (gdb-enable-debug-log)
(gdb-use-inferior-io-buffer, gdb-use-colon-colon-notation)
(gud-gdba-command-name, gdb-show-main, gdb-many-windows):
Add :version keyword.
2004-11-02 Pavel Kobiakov <pk_at_work@yahoo.com>
* progmodes/flymake.el (flymake-err-line-patterns): Use
`flymake-reformat-err-line-patterns-from-compile-el' to convert
`compilation-error-regexp-alist-alist' to internal Flymake format.
* progmodes/flymake.el: eliminated byte-compiler warnings.
2004-11-01 Jay Belanger <belanger@truman.edu>
* calc/calc-frac.el (calc-over-notation): Replaced
`completing-read' with `interactive "s"'.
2004-11-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* mouse.el (mouse-yank-at-click, mouse-yank-secondary):
Revert change from 2004-10-16. '*' checks the current buffer, but the
mouse click may be in another buffer.
2004-11-01 John Paul Wallington <jpw@gnu.org>
* files.el (large-file-warning-threshold): Add :version keyword.
(kill-some-buffers): Doc fix.
* thumbs.el (group thumbs): Add :version keyword.
* textmodes/bibtex.el (bibtex-make-field): Fix typo.
2004-11-01 Richard M. Stallman <rms@gnu.org>
* textmodes/ispell.el (ispell-word): Don't use interactive-p.
* textmodes/flyspell.el (flyspell-word): Don't use interactive-p.
* allout.el (allout group): Add :version.
(allout-init): Don't use interactive-p.
(allout-ascend-to-depth, allout-ascend, allout-end-of-level)
(allout-forward-current-level, allout-backward-current-level):
Don't use interactive-p.
* textmodes/bibtex.el (bibtex-make-field): Don't use interactive-p.
(bibtex-find-text): Likewise.
* progmodes/vhdl-mode.el (vhdl-fill-region)
(vhdl-beginning-of-statement): Don't use interactive-p.
* progmodes/idlwave.el (idlwave-update-routine-info):
Don't use interactive-p.
* progmodes/idlw-shell.el (idlwave-shell-send-char):
Don't use interactive-p.
* progmodes/cperl-mode.el (cperl-switch-to-doc-buffer):
Don't use interactive-p.
* progmodes/ada-xref.el (ada-make-body-gnatstub):
Don't use interactive-p.
* play/fortune.el (fortune-to-signature): Don't use interactive-p.
(fortune-in-buffer): Doc fix.
* play/5x5.el (5x5-new-game): Set up the buffer even if not interactive.
* net/eudc.el (eudc-display-records): Use with-output-to-temp-buffer;
don't select the temporary buffer.
(eudc-get-email): New optional arg ERROR; don't use interactive-p.
(eudc-get-phone): Likewise.
2004-11-01 Kim F. Storm <storm@cua.dk>
* man.el (Man-xref-normal-file): Fix help-echo.
2004-10-31 Stefan Monnier <monnier@iro.umontreal.ca>
* reveal.el (reveal-last-tick): New var.
(reveal-post-command): Use it to avoid closing overlays when we're
appending text to them.
2004-10-31 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
* textmodes/bibtex.el: Require button.
(bibtex-autokey-transcriptions): Translate TeX `\ ' to space.
(bibtex-reference-keys): Distinguish between header keys and
crossref keys.
(bibtex-beginning-of-field): New function.
(bibtex-url-map): Remove.
(bibtex-font-lock-keywords): Use bibtex-font-lock-crossref.
(bibtex-font-lock-url-regexp): Assume that field names begin at
the beginning of a line.
(bibtex-font-lock-url): Simplify. Do not use bibtex-enclosing-field.
Remove field delimiters. Use bibtex-beginning-of-field.
Bugfix, point can be inside a field with a url.
(bibtex-font-lock-crossref, bibtex-button-action, bibtex-button):
New functions.
(bibtex-mark-active, bibtex-run-with-idle-timer): Remove.
(bibtex-key-in-head): Simplify.
(bibtex-current-line): Use bolp.
(bibtex-parse-keys): Remove unused arg `add'.
Use bibtex-type-in-head and bibtex-key-in-head.
(bibtex-parse-entry, bibtex-autofill-entry):
Use bibtex-type-in-head and bibtex-key-in-head.
(bibtex-autokey-get-field): Do not alter case of replacement text.
(bibtex-autokey-get-names): Do all processing of name list.
(bibtex-autokey-get-year): New function.
(bibtex-autokey-get-title): Do all processing of title words.
(bibtex-generate-autokey): Simplify.
(bibtex-string-files-init): Use default-directory.
Allow for absolute file names in bibtex-string-files.
(bibtex-files, bibtex-file-path): New variables.
(bibtex-files-expand): New function.
(bibtex-find-entry-globally): New command.
(bibtex-summary-function): New variable.
(bibtex-summary): Default value of bibtex-summary-function.
(bibtex-find-crossref): New optional args pnt and split.
(bibtex-complete-key-cleanup): Call bibtex-summary-function.
(bibtex-copy-summary-as-kill): New command bound to C-cC-t.
(bibtex-validate): Fix docstring. Check only abbreviated month fields.
Fix handling of required and alternative fields.
Identify duplicate keys even if bibtex-maintain-sorted-entries is nil.
Use cons and display-buffer.
(bibtex-validate-globally): New command.
(bibtex-clean-entry): Use bibtex-files-expand. Do not call
bibtex-parse-keys and bibtex-parse-strings for updating
bibtex-reference-keys and bibtex-strings.
(bibtex-realign): Remove blank lines past the last entry.
(bibtex-reformat): Use bibtex-entry-format as default.
(bibtex-choose-completion-string): Remove.
(bibtex-complete): Do not use bibtex-choose-completion-string.
(bibtex-url): Simplify.
2004-10-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* x-dnd.el (x-dnd-test-function, x-dnd-protocol-alist)
(x-dnd-types-alist, x-dnd-open-file-other-window)
(x-dnd-known-types): Add :version.
2004-10-31 John Paul Wallington <jpw@gnu.org>
* ibuffer.el (group ibuffer): Add :version keyword.
2004-10-31 Kim F. Storm <storm@cua.dk>
* ido.el (group ido): Add :version keyword.
(ido-mode): Remove :version keyword.
* emulation/cua-base.el (group cua): Add :version keyword.
(cua-mode): Remove :version keyword.
2004-10-30 Luc Teirlinck <teirllm@auburn.edu>
* autorevert.el (auto-revert-tail-mode-text): Add :version keyword.
* help-at-pt.el (help-at-pt-timer): Move defvar up to avoid
compiler warning.
(help-at-pt-timer-delay): Add :initialize keyword. Simplify :set
function.
(help-at-pt-display-when-idle): Remove autoload.
2004-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
* makefile.w32-in (custom-deps, autoloads): Fix *-hooks -> *-hook.
2004-10-30 Juri Linkov <juri@jurta.org>
* help.el (function-called-at-point):
* help-fns.el (variable-at-point): Read -> intern.
2004-10-30 Simon Josefsson <jas@extundo.com>
* progmodes/autoconf.el (autoconf-font-lock-keywords): Recognize
AS_* too.
* progmodes/autoconf.el (autoconf-font-lock-keywords):
Recognize AS_* too.
2004-10-29 Simon Josefsson <jas@extundo.com>
@ -18,7 +357,7 @@
* mouse.el (mouse-show-mark): Replace the last occurrence of
x-lost-selection-hooks with x-lost-selection-functions.
2004-10-28 Stefan <monnier@iro.umontreal.ca>
2004-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
* mouse.el (mouse-show-mark): Adjust to new name and don't assume
x-lost-selection-functions is bound.
@ -70,8 +409,8 @@
2004-10-28 Kenichi Handa <handa@m17n.org>
* international/utf-8.el (utf-translate-cjk-charsets): Add
katakana-jisx0201.
* international/utf-8.el (utf-translate-cjk-charsets):
Add katakana-jisx0201.
* international/subst-jis.el: Add data for JISX0201.
@ -1126,7 +1465,7 @@
2004-09-17 Jay Belanger <belanger@truman.edu>
* calc/calc.el (calc-mode-var-list): Fixed the value of
* calc/calc.el (calc-mode-var-list): Fix the value of
`calc-matrix-brackets'.
2004-09-17 Romain Francoise <romain@orebokech.com>

61
lisp/allout.el
View file

@ -68,7 +68,8 @@
(defgroup allout nil
"Extensive outline mode for use alone and with other modes."
:prefix "allout-"
:group 'editing)
:group 'editing
:version "21.4")
;;;_ + Layout, Mode, and Topic Header Configuration
@ -954,20 +955,16 @@ the following two lines in your Emacs init file:
\(require 'allout)
\(allout-init t)"
(interactive)
(if (interactive-p)
(progn
(setq mode
(completing-read
(concat "Select outline auto setup mode "
"(empty for report, ? for options) ")
'(("nil")("full")("activate")("deactivate")
("ask") ("report") (""))
nil
t))
(if (string= mode "")
(setq mode 'report)
(setq mode (intern-soft mode)))))
(interactive
(let ((m (completing-read
(concat "Select outline auto setup mode "
"(empty for report, ? for options) ")
'(("nil")("full")("activate")("deactivate")
("ask") ("report") (""))
nil
t)))
(if (string= m "") 'report
(intern-soft m))))
(let
;; convenience aliases, for consistent ref to respective vars:
((hook 'allout-find-file-hook)
@ -1902,16 +1899,12 @@ If already there, move cursor to bullet for hot-spot operation.
(if (= (allout-recent-depth) depth)
(progn (goto-char allout-recent-prefix-beginning)
depth)
(goto-char last-good)
nil))
(if (interactive-p) (allout-end-of-prefix))))
(goto-char last-good)))))
;;;_ > allout-ascend ()
(defun allout-ascend ()
"Ascend one level, returning t if successful, nil if not."
(prog1
(if (allout-beginning-of-level)
(allout-previous-heading))
(if (interactive-p) (allout-end-of-prefix))))
(if (allout-beginning-of-level)
(allout-previous-heading)))
;;;_ > allout-descend-to-depth (depth)
(defun allout-descend-to-depth (depth)
"Descend to depth DEPTH within current topic.
@ -1931,13 +1924,13 @@ Returning depth if successful, nil if not."
nil))
)
;;;_ > allout-up-current-level (arg &optional dont-complain)
(defun allout-up-current-level (arg &optional dont-complain)
(defun allout-up-current-level (arg &optional dont-complain interactive)
"Move out ARG levels from current visible topic.
Positions on heading line of containing topic. Error if unable to
ascend that far, or nil if unable to ascend but optional arg
DONT-COMPLAIN is non-nil."
(interactive "p")
(interactive "p\np")
(allout-back-to-current-heading)
(let ((present-level (allout-recent-depth))
(last-good (point))
@ -1958,12 +1951,12 @@ DONT-COMPLAIN is non-nil."
(if (or failed
(> arg 0))
(progn (goto-char last-good)
(if (interactive-p) (allout-end-of-prefix))
(if interactive (allout-end-of-prefix))
(if (not dont-complain)
(error "Can't ascend past outermost level")
(if (interactive-p) (allout-end-of-prefix))
(if interactive (allout-end-of-prefix))
nil))
(if (interactive-p) (allout-end-of-prefix))
(if interactive (allout-end-of-prefix))
allout-recent-prefix-beginning)))
;;;_ - Linear
@ -2029,7 +2022,7 @@ Presumes point is at the start of a topic prefix."
(let ((depth (allout-depth)))
(while (allout-previous-sibling depth nil))
(prog1 (allout-recent-depth)
(if (interactive-p) (allout-end-of-prefix)))))
(allout-end-of-prefix))))
;;;_ > allout-next-visible-heading (arg)
(defun allout-next-visible-heading (arg)
"Move to the next ARG'th visible heading line, backward if arg is negative.
@ -2067,13 +2060,13 @@ matches)."
(interactive "p")
(allout-next-visible-heading (- arg)))
;;;_ > allout-forward-current-level (arg)
(defun allout-forward-current-level (arg)
(defun allout-forward-current-level (arg &optional interactive)
"Position point at the next heading of the same level.
Takes optional repeat-count, goes backward if count is negative.
Returns resulting position, else nil if none found."
(interactive "p")
(interactive "p\np")
(let ((start-depth (allout-current-depth))
(start-point (point))
(start-arg arg)
@ -2101,7 +2094,7 @@ Returns resulting position, else nil if none found."
(= (allout-recent-depth) start-depth)))
allout-recent-prefix-beginning
(goto-char last-good)
(if (not (interactive-p))
(if (not interactive)
nil
(allout-end-of-prefix)
(error "Hit %s level %d topic, traversed %d of %d requested"
@ -2110,10 +2103,10 @@ Returns resulting position, else nil if none found."
(- (abs start-arg) arg)
(abs start-arg))))))
;;;_ > allout-backward-current-level (arg)
(defun allout-backward-current-level (arg)
(defun allout-backward-current-level (arg &optional interactive)
"Inverse of `allout-forward-current-level'."
(interactive "p")
(if (interactive-p)
(interactive "p\np")
(if interactive
(let ((current-prefix-arg (* -1 arg)))
(call-interactively 'allout-forward-current-level))
(allout-forward-current-level (* -1 arg))))

3
lisp/autorevert.el
View file

@ -172,7 +172,8 @@ When non-nil, a message is generated whenever a file is reverted."
\(When the string is not empty, make sure that it has a leading space.)"
:group 'auto-revert
:type 'string)
:type 'string
:version "21.4")
(defcustom auto-revert-mode-hook nil
"Functions to run when Auto-Revert Mode is activated."

5
lisp/buff-menu.el
View file

@ -627,8 +627,9 @@ For more information, see the function `buffer-menu'."
(define-key map [header-line mouse-2]
`(lambda (e)
(interactive "e")
(if e (set-buffer (window-buffer (posn-window (event-end e)))))
(Buffer-menu-sort ,column)))
(save-window-excursion
(if e (mouse-select-window e))
(Buffer-menu-sort ,column))))
map)))
(defun list-buffers-noselect (&optional files-only)

7
lisp/calc/calc-frac.el
View file

@ -54,12 +54,7 @@
(defun calc-over-notation (fmt)
(interactive
(list
(completing-read "Fraction separator: " (mapcar (lambda (s)
(cons s 0))
'(":" "::" "/" "//" ":/"))
nil t)))
(interactive "sFraction separator: ")
(calc-wrapper
(if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt)
(let ((n nil))

724
lisp/calendar/icalendar.el
View file

@ -31,16 +31,7 @@
;;; History:
;; 0.07: Renamed commands!
;; icalendar-extract-ical-from-buffer -> icalendar-import-buffer
;; icalendar-convert-diary-to-ical -> icalendar-export-file
;; Naming scheme: icalendar-.* = user command; icalendar--.* =
;; internal.
;; Added icalendar-export-region.
;; The import and export commands do not clear their target file,
;; but append their results to the target file.
;; I18n-problems fixed -- use calendar-(month|day)-name-array.
;; Fixed problems with export of multi-line diary entries.
;; 0.07 onwards: see lisp/ChangeLog
;; 0.06: Bugfixes regarding icalendar-import-format-*.
;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp
@ -99,7 +90,7 @@
;;; Code:
(defconst icalendar-version 0.07
(defconst icalendar-version 0.08
"Version number of icalendar.el.")
;; ======================================================================
@ -333,7 +324,7 @@ children."
param-name param-value)
(when value-string
(save-current-buffer
(set-buffer (get-buffer-create " *ical-temp*"))
(set-buffer (get-buffer-create " *icalendar-work*"))
(set-buffer-modified-p nil)
(erase-buffer)
(insert value-string)
@ -529,7 +520,17 @@ Note that this silently ignores seconds."
(setq num (1+ num))))
calendar-day-name-array))
;; Error:
"??"))
nil))
(defun icalendar--date-to-isodate (date &optional day-shift)
"Convert DATE to iso-style date.
DATE must be a list of the form (month day year).
If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
(let ((mdy (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian date)
(or day-shift 0)))))
(format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
(defun icalendar--datestring-to-isodate (datestring &optional day-shift)
"Convert diary-style DATESTRING to iso-style date.
@ -587,7 +588,7 @@ takes care of european-style."
(if (> day 0)
(let ((mdy (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian (list month day
year))
year))
(or day-shift 0)))))
(format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
nil)))
@ -625,22 +626,24 @@ would be \"pm\"."
"Export diary file to iCalendar format.
All diary entries in the file DIARY-FILENAME are converted to iCalendar
format. The result is appended to the file ICAL-FILENAME."
(interactive "FExport diary data from file:
(interactive "FExport diary data from file:
Finto iCalendar file: ")
(save-current-buffer
(set-buffer (find-file diary-filename))
(icalendar-export-region (point-min) (point-max) ical-filename)))
(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file
"icalendar 0.07")
(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file)
;; User function
(defun icalendar-export-region (min max ical-filename)
"Export region in diary file to iCalendar format.
All diary entries in the region from MIN to MAX in the current buffer are
converted to iCalendar format. The result is appended to the file
ICAL-FILENAME."
ICAL-FILENAME.
Returns non-nil if an error occurred. In this case an error message is
written to the buffer ` *icalendar-errors*'."
(interactive "r
FExport diary data into iCalendar file: ")
(let ((result "")
@ -649,9 +652,14 @@ FExport diary data into iCalendar file: ")
(entry-rest "")
(header "")
(contents)
(oops nil)
(found-error nil)
(nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
"?")))
;; prepare buffer with error messages
(save-current-buffer
(set-buffer (get-buffer-create " *icalendar-errors*"))
(erase-buffer))
;; here we go
(save-excursion
(goto-char min)
(while (re-search-forward
@ -664,330 +672,366 @@ FExport diary data into iCalendar file: ")
(car (current-time))
(cadr (current-time))
(car (cddr (current-time)))))
(setq oops nil)
(cond
;; anniversaries
((string-match
(concat nonmarker
"%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-anniversary %s" entry-main)
(let* ((datetime (substring entry-main (match-beginning 1)
(match-end 1)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 2)
(match-end 2))))
(startisostring (icalendar--datestring-to-isodate
datetime))
(endisostring (icalendar--datestring-to-isodate
datetime 1)))
(setq contents
(concat "\nDTSTART;VALUE=DATE:" startisostring
"\nDTEND;VALUE=DATE:" endisostring
"\nSUMMARY:" summary
"\nRRULE:FREQ=YEARLY;INTERVAL=1"
;; the following is redundant,
;; but korganizer seems to expect this... ;(
;; and evolution doesn't understand it... :(
;; so... who is wrong?!
";BYMONTH=" (substring startisostring 4 6)
";BYMONTHDAY=" (substring startisostring 6 8)
)))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest)))))
;; cyclic events
;; %%(diary-cyclic )
((string-match
(concat nonmarker
"%%(diary-cyclic \\([^ ]+\\) +"
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-cyclic %s" entry-main)
(let* ((frequency (substring entry-main (match-beginning 1)
(match-end 1)))
(datetime (substring entry-main (match-beginning 2)
(match-end 2)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 3)
(match-end 3))))
(startisostring (icalendar--datestring-to-isodate
datetime))
(endisostring (icalendar--datestring-to-isodate
datetime 1)))
(setq contents
(concat "\nDTSTART;VALUE=DATE:" startisostring
"\nDTEND;VALUE=DATE:" endisostring
"\nSUMMARY:" summary
"\nRRULE:FREQ=DAILY;INTERVAL=" frequency
;; strange: korganizer does not expect
;; BYSOMETHING here...
)))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest)))))
;; diary-date -- FIXME
((string-match
(concat nonmarker
"%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-date %s" entry-main)
(setq oops t))
;; float events -- FIXME
((string-match
(concat nonmarker
"%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-float %s" entry-main)
(setq oops t))
;; block events
((string-match
(concat nonmarker
"%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +"
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-block %s" entry-main)
(let* ((startstring (substring entry-main (match-beginning 1)
(match-end 1)))
(endstring (substring entry-main (match-beginning 2)
(match-end 2)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 3)
(match-end 3))))
(startisostring (icalendar--datestring-to-isodate
startstring))
(endisostring (icalendar--datestring-to-isodate
endstring 1)))
(setq contents
(concat "\nDTSTART;VALUE=DATE:" startisostring
"\nDTEND;VALUE=DATE:" endisostring
"\nSUMMARY:" summary
))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest))))))
;; other sexp diary entries -- FIXME
((string-match
(concat nonmarker
"%%(\\([^)]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-sexp %s" entry-main)
(setq oops t))
;; weekly by day
;; Monday 8:30 Team meeting
((and (string-match
(concat nonmarker
"\\([a-z]+\\)\\s-+"
"\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\(-0?"
"\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\(.*\\)$")
entry-main)
(icalendar--get-weekday-abbrev
(substring entry-main (match-beginning 1) (match-end 1))))
(icalendar--dmsg "weekly %s" entry-main)
(let* ((day (icalendar--get-weekday-abbrev
(substring entry-main (match-beginning 1)
(match-end 1))))
(starttimestring (icalendar--diarytime-to-isotime
(if (match-beginning 3)
(substring entry-main
(match-beginning 3)
(match-end 3))
nil)
(if (match-beginning 4)
(substring entry-main
(match-beginning 4)
(match-end 4))
nil)))
(endtimestring (icalendar--diarytime-to-isotime
(if (match-beginning 6)
(substring entry-main
(match-beginning 6)
(match-end 6))
nil)
(if (match-beginning 7)
(substring entry-main
(match-beginning 7)
(match-end 7))
nil)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 8)
(match-end 8)))))
(when starttimestring
(unless endtimestring
(let ((time (read (icalendar--rris "^T0?" ""
starttimestring))))
(setq endtimestring (format "T%06d" (+ 10000 time))))))
(setq contents
(concat "\nDTSTART"
(if starttimestring "" ";VALUE=DATE")
":19000101" ;; FIXME? Probability that this
;; is the right day is 1/7
(or starttimestring "")
"\nDTEND"
(if endtimestring "" ";VALUE=DATE")
":19000101" ;; FIXME?
(or endtimestring "")
"\nSUMMARY:" summary
"\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day
)))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest)))))
;; yearly by day
;; 1 May Tag der Arbeit
((string-match
(concat nonmarker
(if european-calendar-style
"0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
"\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
"\\*?\\s-*"
"\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\("
"-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\([^0-9]+.*\\)$" ; must not match years
)
entry-main)
(icalendar--dmsg "yearly %s" entry-main)
(let* ((daypos (if european-calendar-style 1 2))
(monpos (if european-calendar-style 2 1))
(day (read (substring entry-main (match-beginning daypos)
(match-end daypos))))
(month (icalendar--get-month-number
(substring entry-main (match-beginning monpos)
(match-end monpos))))
(starttimestring (icalendar--diarytime-to-isotime
(if (match-beginning 4)
(substring entry-main
(match-beginning 4)
(match-end 4))
nil)
(if (match-beginning 5)
(substring entry-main
(match-beginning 5)
(match-end 5))
nil)))
(endtimestring (icalendar--diarytime-to-isotime
(if (match-beginning 7)
(substring entry-main
(match-beginning 7)
(match-end 7))
nil)
(if (match-beginning 8)
(substring entry-main
(match-beginning 8)
(match-end 8))
nil)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 9)
(match-end 9)))))
(when starttimestring
(unless endtimestring
(let ((time (read (icalendar--rris "^T0?" ""
starttimestring))))
(setq endtimestring (format "T%06d" (+ 10000 time))))))
(setq contents
(concat "\nDTSTART"
(if starttimestring "" ";VALUE=DATE")
(format ":1900%02d%02d" month day)
(or starttimestring "")
"\nDTEND"
(if endtimestring "" ";VALUE=DATE")
(format ":1900%02d%02d" month day)
(or endtimestring "")
"\nSUMMARY:" summary
"\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
(format "%2d" month)
";BYMONTHDAY="
(format "%2d" day)
)))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest)))))
;; "ordinary" events, start and end time given
;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich
((string-match
(concat nonmarker
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+"
"\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\("
"-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "ordinary %s" entry-main)
(let* ((datestring (icalendar--datestring-to-isodate
(substring entry-main (match-beginning 1)
(match-end 1))))
(starttimestring (icalendar--diarytime-to-isotime
(if (match-beginning 3)
(substring entry-main
(match-beginning 3)
(match-end 3))
nil)
(if (match-beginning 4)
(substring entry-main
(match-beginning 4)
(match-end 4))
nil)))
(endtimestring (icalendar--diarytime-to-isotime
(if (match-beginning 6)
(substring entry-main
(match-beginning 6)
(match-end 6))
nil)
(if (match-beginning 7)
(substring entry-main
(match-beginning 7)
(match-end 7))
nil)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 8)
(match-end 8)))))
(when starttimestring
(unless endtimestring
(let ((time (read (icalendar--rris "^T0?" ""
starttimestring))))
(setq endtimestring (format "T%06d" (+ 10000 time))))))
(setq contents (format
"\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s"
(if starttimestring "" ";VALUE=DATE")
datestring
(or starttimestring "")
(if endtimestring ""
";VALUE=DATE")
datestring
(or endtimestring "")
summary))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest))))))
;; everything else
(t
;; Oops! what's that?
(setq oops t)))
(if oops
(message "Cannot export entry on line %d"
(count-lines (point-min) (point)))
(setq result (concat result header contents "\nEND:VEVENT"))))
(condition-case error-val
(progn
(cond
;; anniversaries
((string-match
(concat nonmarker
"%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-anniversary %s" entry-main)
(let* ((datetime (substring entry-main (match-beginning 1)
(match-end 1)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 2)
(match-end 2))))
(startisostring (icalendar--datestring-to-isodate
datetime))
(endisostring (icalendar--datestring-to-isodate
datetime 1)))
(setq contents
(concat "\nDTSTART;VALUE=DATE:" startisostring
"\nDTEND;VALUE=DATE:" endisostring
"\nSUMMARY:" summary
"\nRRULE:FREQ=YEARLY;INTERVAL=1"
;; the following is redundant,
;; but korganizer seems to expect this... ;(
;; and evolution doesn't understand it... :(
;; so... who is wrong?!
";BYMONTH=" (substring startisostring 4 6)
";BYMONTHDAY=" (substring startisostring 6 8)
)))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest)))))
;; cyclic events
;; %%(diary-cyclic )
((string-match
(concat nonmarker
"%%(diary-cyclic \\([^ ]+\\) +"
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-cyclic %s" entry-main)
(let* ((frequency (substring entry-main (match-beginning 1)
(match-end 1)))
(datetime (substring entry-main (match-beginning 2)
(match-end 2)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 3)
(match-end 3))))
(startisostring (icalendar--datestring-to-isodate
datetime))
(endisostring (icalendar--datestring-to-isodate
datetime 1)))
(setq contents
(concat "\nDTSTART;VALUE=DATE:" startisostring
"\nDTEND;VALUE=DATE:" endisostring
"\nSUMMARY:" summary
"\nRRULE:FREQ=DAILY;INTERVAL=" frequency
;; strange: korganizer does not expect
;; BYSOMETHING here...
)))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest)))))
;; diary-date -- FIXME
((string-match
(concat nonmarker
"%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-date %s" entry-main)
(error "`diary-date' is not supported yet"))
;; float events -- FIXME
((string-match
(concat nonmarker
"%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-float %s" entry-main)
(error "`diary-float' is not supported yet"))
;; block events
((string-match
(concat nonmarker
"%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +"
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-block %s" entry-main)
(let* ((startstring (substring entry-main (match-beginning 1)
(match-end 1)))
(endstring (substring entry-main (match-beginning 2)
(match-end 2)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 3)
(match-end 3))))
(startisostring (icalendar--datestring-to-isodate
startstring))
(endisostring (icalendar--datestring-to-isodate
endstring 1)))
(setq contents
(concat "\nDTSTART;VALUE=DATE:" startisostring
"\nDTEND;VALUE=DATE:" endisostring
"\nSUMMARY:" summary
))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest))))))
;; other sexp diary entries -- FIXME
((string-match
(concat nonmarker
"%%(\\([^)]+\\))\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "diary-sexp %s" entry-main)
(error "sexp-entries are not supported yet"))
;; weekly by day
;; Monday 8:30 Team meeting
((and (string-match
(concat nonmarker
"\\([a-z]+\\)\\s-+"
"\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\(-0?"
"\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\(.*\\)$")
entry-main)
(icalendar--get-weekday-abbrev
(substring entry-main (match-beginning 1) (match-end 1))))
(icalendar--dmsg "weekly %s" entry-main)
(let* ((day (icalendar--get-weekday-abbrev
(substring entry-main (match-beginning 1)
(match-end 1))))
(starttimestring (icalendar--diarytime-to-isotime
(if (match-beginning 3)
(substring entry-main
(match-beginning 3)
(match-end 3))
nil)
(if (match-beginning 4)
(substring entry-main
(match-beginning 4)
(match-end 4))
nil)))
(endtimestring (icalendar--diarytime-to-isotime
(if (match-beginning 6)
(substring entry-main
(match-beginning 6)
(match-end 6))
nil)
(if (match-beginning 7)
(substring entry-main
(match-beginning 7)
(match-end 7))
nil)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 8)
(match-end 8)))))
(when starttimestring
(unless endtimestring
(let ((time (read (icalendar--rris "^T0?" ""
starttimestring))))
(setq endtimestring (format "T%06d" (+ 10000 time))))))
(setq contents
(concat "\nDTSTART;"
(if starttimestring
"VALUE=DATE-TIME:"
"VALUE=DATE:")
;; find the correct week day,
;; 1st january 2000 was a saturday
(format
"200001%02d"
(+ (icalendar--get-weekday-number day) 2))
(or starttimestring "")
"\nDTEND;"
(if endtimestring
"VALUE=DATE-TIME:"
"VALUE=DATE:")
(format
"200001%02d"
;; end is non-inclusive!
(+ (icalendar--get-weekday-number day)
(if endtimestring 2 3)))
(or endtimestring "")
"\nSUMMARY:" summary
"\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day
)))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest)))))
;; yearly by day
;; 1 May Tag der Arbeit
((string-match
(concat nonmarker
(if european-calendar-style
"0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
"\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
"\\*?\\s-*"
"\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\("
"-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\([^0-9]+.*\\)$" ; must not match years
)
entry-main)
(icalendar--dmsg "yearly %s" entry-main)
(let* ((daypos (if european-calendar-style 1 2))
(monpos (if european-calendar-style 2 1))
(day (read (substring entry-main (match-beginning daypos)
(match-end daypos))))
(month (icalendar--get-month-number
(substring entry-main (match-beginning monpos)
(match-end monpos))))
(starttimestring (icalendar--diarytime-to-isotime
(if (match-beginning 4)
(substring entry-main
(match-beginning 4)
(match-end 4))
nil)
(if (match-beginning 5)
(substring entry-main
(match-beginning 5)
(match-end 5))
nil)))
(endtimestring (icalendar--diarytime-to-isotime
(if (match-beginning 7)
(substring entry-main
(match-beginning 7)
(match-end 7))
nil)
(if (match-beginning 8)
(substring entry-main
(match-beginning 8)
(match-end 8))
nil)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 9)
(match-end 9)))))
(when starttimestring
(unless endtimestring
(let ((time (read (icalendar--rris "^T0?" ""
starttimestring))))
(setq endtimestring (format "T%06d" (+ 10000 time))))))
(setq contents
(concat "\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
(format "1900%02d%02d" month day)
(or starttimestring "")
"\nDTEND;"
(if endtimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
;; end is not included! shift by one day
(icalendar--date-to-isodate
(list month day 1900) (if endtimestring 0 1))
(or endtimestring "")
"\nSUMMARY:"
summary
"\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
(format "%2d" month)
";BYMONTHDAY="
(format "%2d" day)
)))
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest)))))
;; "ordinary" events, start and end time given
;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich
((string-match
(concat nonmarker
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+"
"\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
"\\("
"-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
"\\)?"
"\\s-*\\(.*\\)")
entry-main)
(icalendar--dmsg "ordinary %s" entry-main)
(let* ((startdatestring (icalendar--datestring-to-isodate
(substring entry-main
(match-beginning 1)
(match-end 1))))
(starttimestring (icalendar--diarytime-to-isotime
(if (match-beginning 3)
(substring entry-main
(match-beginning 3)
(match-end 3))
nil)
(if (match-beginning 4)
(substring entry-main
(match-beginning 4)
(match-end 4))
nil)))
(endtimestring (icalendar--diarytime-to-isotime
(if (match-beginning 6)
(substring entry-main
(match-beginning 6)
(match-end 6))
nil)
(if (match-beginning 7)
(substring entry-main
(match-beginning 7)
(match-end 7))
nil)))
(summary (icalendar--convert-string-for-export
(substring entry-main (match-beginning 8)
(match-end 8)))))
(unless startdatestring
(error "Could not parse date"))
(when starttimestring
(unless endtimestring
(let ((time (read (icalendar--rris "^T0?" ""
starttimestring))))
(setq endtimestring (format "T%06d" (+ 10000 time))))))
(setq contents (concat
"\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
startdatestring
(or starttimestring "")
"\nDTEND;"
(if endtimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
(icalendar--datestring-to-isodate
(substring entry-main
(match-beginning 1)
(match-end 1))
(if endtimestring 0 1))
(or endtimestring "")
"\nSUMMARY:"
summary))
;; could not parse the date
(unless (string= entry-rest "")
(setq contents (concat contents "\nDESCRIPTION:"
(icalendar--convert-string-for-export
entry-rest))))))
;; everything else
(t
;; Oops! what's that?
(error "Could not parse entry")))
(setq result (concat result header contents "\nEND:VEVENT")))
;; handle errors
(error
(setq found-error t)
(save-current-buffer
(set-buffer (get-buffer-create " *icalendar-errors*"))
(insert (format "Error in line %d -- %s: `%s'\n"
(count-lines (point-min) (point))
(cadr error-val)
entry-main))))))
;; we're done, insert everything into the file
(let ((coding-system-for-write 'utf8))
(set-buffer (find-file ical-filename))
(goto-char (point-max))
(insert "BEGIN:VCALENDAR")
(insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
(insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
(insert "\nVERSION:2.0")
(insert result)
(insert "\nEND:VCALENDAR\n")))))
(insert "\nEND:VCALENDAR\n")))
found-error))
;; ======================================================================
;; Import -- convert icalendar to emacs-diary
@ -1001,7 +1045,7 @@ Argument ICAL-FILENAME output iCalendar file.
Argument DIARY-FILENAME input `diary-file'.
Optional argument NON-MARKING determines whether events are created as
non-marking or not."
(interactive "fImport iCalendar data from file:
(interactive "fImport iCalendar data from file:
Finto diary file:
p")
;; clean up the diary file
@ -1062,9 +1106,7 @@ reading, parsing, or converting iCalendar data!"
"Current buffer does not contain icalendar contents!"))))
(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer
"icalendar 0.07")
(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
;; ======================================================================
;; private area
@ -1184,7 +1226,7 @@ written into the buffer ` *icalendar-errors*'."
(setq diary-string
(format "%s %s%s%s"
(aref calendar-day-name-array
weekday)
weekday)
start-t (if end-t "-" "")
(or end-t "")))
;; FIXME!!!!

2
lisp/comint.el
View file

@ -788,7 +788,7 @@ buffer. The hook `comint-exec-hook' is run after each exec."
(defun comint-insert-input (&optional event)
"In a Comint buffer, set the current input to the previous input at point."
(interactive "@")
(interactive "e")
(if event (mouse-set-point event))
(let ((pos (point)))
(if (not (eq (get-char-property pos 'field) 'input))

14
lisp/cus-edit.el
View file

@ -896,15 +896,14 @@ then prompt for the MODE to customize."
(let ((name (format "*Customize Group: %s*"
(custom-unlispify-tag-name group))))
(if (get-buffer name)
(let ((window (selected-window))
(let (
;; Copied from `custom-buffer-create-other-window'.
(pop-up-windows t)
(special-display-buffer-names nil)
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
(pop-to-buffer name)
(select-window window))
(pop-to-buffer name))
(custom-buffer-create-other-window
(list (list group 'custom-group))
name
@ -1240,21 +1239,20 @@ that option."
;;;###autoload
(defun custom-buffer-create-other-window (options &optional name description)
"Create a buffer containing OPTIONS.
"Create a buffer containing OPTIONS, and display it in another window.
The result includes selecting that window.
Optional NAME is the name of the buffer.
OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
SYMBOL is a customization option, and WIDGET is a widget for editing
that option."
(unless name (setq name "*Customization*"))
(let ((window (selected-window))
(pop-up-windows t)
(let ((pop-up-windows t)
(special-display-buffer-names nil)
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
(pop-to-buffer (custom-get-fresh-buffer name))
(custom-buffer-create-internal options description)
(select-window window)))
(custom-buffer-create-internal options description)))
(defcustom custom-reset-button-menu nil
"If non-nil, only show a single reset button in customize buffers.

9
lisp/descr-text.el
View file

@ -176,11 +176,12 @@ otherwise."
(describe-text-properties-1 pos output-buffer)
(if (not (or (text-properties-at pos) (overlays-at pos)))
(message "This is plain text.")
(let ((buffer (current-buffer)))
(when (eq buffer (get-buffer "*Help*"))
(error "Can't do self inspection"))
(let ((buffer (current-buffer))
(target-buffer "*Help*"))
(when (eq buffer (get-buffer target-buffer))
(setq target-buffer "*Help-2*"))
(save-excursion
(with-output-to-temp-buffer "*Help*"
(with-output-to-temp-buffer target-buffer
(set-buffer standard-output)
(setq output-buffer (current-buffer))
(widget-insert "Text content at position " (format "%d" pos) ":\n\n")

10
lisp/dired.el
View file

@ -546,8 +546,14 @@ Optional third argument FILTER, if non-nil, is a function to select
(if current-prefix-arg
(read-string "Dired listing switches: "
dired-listing-switches))
(read-file-name (format "Dired %s(directory): " str)
nil default-directory nil))))
;; If a dialog is about to be used, call read-directory-name so
;; the dialog code knows we want directories. Some dialogs can
;; only select directories or files when popped up, not both.
(if (next-read-file-uses-dialog-p)
(read-directory-name (format "Dired %s(directory): " str)
nil default-directory nil)
(read-file-name (format "Dired %s(directory): " str)
nil default-directory nil)))))
;;;###autoload (define-key ctl-x-map "d" 'dired)
;;;###autoload

4
lisp/ehelp.el
View file

@ -85,11 +85,11 @@
(define-key map "<" 'beginning-of-buffer)
(define-key map ">" 'end-of-buffer)
;(define-key map "\C-g" 'electric-help-exit)
(define-key map "q" 'electric-help-exit)
(define-key map "Q" 'electric-help-exit)
(define-key map "q" 'electric-help-exit)
;;a better key than this?
(define-key map "r" 'electric-help-retain)
(define-key map "R" 'electric-help-retain)
(define-key map "r" 'electric-help-retain)
(define-key map "\ex" 'electric-help-execute-extended)
(define-key map "\C-x" 'electric-help-ctrl-x-prefix)

2
lisp/emacs-lisp/advice.el
View file

@ -3106,7 +3106,7 @@ in any of these classes."
(not advised-interactive-form))
;; Check whether we were called interactively
;; in order to do proper prompting:
`(if (interactive-p)
`(if (called-interactively-p)
(call-interactively ',origname)
,(ad-make-mapped-call orig-arglist
advised-arglist

11
lisp/emacs-lisp/autoload.el
View file

@ -360,11 +360,14 @@ are used."
(message "Generating autoloads for %s...done" file)))
;;;###autoload
(defun update-file-autoloads (file)
(defun update-file-autoloads (file &optional save-after)
"Update the autoloads for FILE in `generated-autoload-file'
\(which FILE might bind in its local variables).
Return FILE if there was no autoload cookie in it."
(interactive "fUpdate autoloads for file: ")
If SAVE-AFTER is non-nil (which is always, when called interactively),
save the buffer too.
Return FILE if there was no autoload cookie in it, else nil."
(interactive "fUpdate autoloads for file: \np")
(let ((load-name (let ((name (file-name-nondirectory file)))
(if (string-match "\\.elc?\\(\\.\\|$\\)" name)
(substring name 0 (match-beginning 0))
@ -464,7 +467,7 @@ Autoload section for %s is up to date."
(or existing-buffer
(kill-buffer (current-buffer))))))))
(generate-file-autoloads file))))
(and (interactive-p)
(and save-after
(buffer-modified-p)
(save-buffer))

22
lisp/emacs-lisp/bytecomp.el
View file

@ -98,6 +98,9 @@
;; `obsolete' (obsolete variables and functions)
;; `noruntime' (calls to functions only defined
;; within `eval-when-compile')
;; `cl-warnings' (calls to CL functions)
;; `interactive-only' (calls to commands that are
;; not good to call from Lisp)
;; byte-compile-compatibility Whether the compiler should
;; generate .elc files which can be loaded into
;; generic emacs 18.
@ -325,7 +328,8 @@ If it is 'byte, then only byte-level optimizations will be logged."
:type 'boolean)
(defconst byte-compile-warning-types
'(redefine callargs free-vars unresolved obsolete noruntime cl-functions)
'(redefine callargs free-vars unresolved
obsolete noruntime cl-functions interactive-only)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
"*List of warnings that the byte-compiler should issue (t for all).
@ -341,13 +345,21 @@ Elements of the list may be be:
noruntime functions that may not be defined at runtime (typically
defined only under `eval-when-compile').
cl-functions calls to runtime functions from the CL package (as
distinguished from macros and aliases)."
distinguished from macros and aliases).
interactive-only
commands that normally shouldn't be called from Lisp code."
:group 'bytecomp
:type `(choice (const :tag "All" t)
(set :menu-tag "Some"
(const free-vars) (const unresolved)
(const callargs) (const redefine)
(const obsolete) (const noruntime) (const cl-functions))))
(const obsolete) (const noruntime)
(const cl-functions) (const interactive-only))))
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
insert-file)
"List of commands that are not meant to be called from Lisp.")
(defvar byte-compile-not-obsolete-var nil
"If non-nil, this is a variable that shouldn't be reported as obsolete.")
@ -2710,6 +2722,10 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(byte-compile-set-symbol-position fn)
(when (byte-compile-const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
(and (memq 'interactive-only byte-compile-warnings)
(memq (car form) byte-compile-interactive-only-functions)
(byte-compile-warn "`%s' used from Lisp code\n\
That command is designed for interactive use only" fn))
(if (and handler
(or (not (byte-compile-version-cond
byte-compile-compatibility))

2
lisp/emacs-lisp/easy-mmode.el
View file

@ -209,7 +209,7 @@ With zero or negative ARG turn mode off.
,@body
;; The on/off hooks are here for backward compatibility only.
(run-hooks ',hook (if ,mode ',hook-on ',hook-off))
(if (interactive-p)
(if (called-interactively-p)
(progn
,(if globalp `(customize-mark-as-set ',mode))
(unless (current-message)

20
lisp/emacs-lisp/easymenu.el
View file

@ -42,7 +42,25 @@ menus, turn this variable off, otherwise it is probably better to keep it on."
:version "20.3")
(defsubst easy-menu-intern (s)
(if (stringp s) (intern (downcase s)) s))
(if (stringp s)
(let ((copy (copy-sequence s))
(pos 0)
found)
;; For each letter that starts a word, flip its case.
;; This way, the usual convention for menu strings (capitalized)
;; corresponds to the usual convention for menu item event types
;; (all lower case). It's a 1-1 mapping so causes no conflicts.
(while (setq found (string-match "\\<\\sw" copy pos))
(setq pos (match-end 0))
(unless (= (upcase (aref copy found))
(downcase (aref copy found)))
(aset copy found
(if (= (upcase (aref copy found))
(aref copy found))
(downcase (aref copy found))
(upcase (aref copy found))))))
(intern copy))
s))
;;;###autoload
(put 'easy-menu-define 'lisp-indent-function 'defun)

6
lisp/emacs-lisp/edebug.el
View file

@ -714,8 +714,10 @@ already is one.)"
(if (and (eq (following-char) ?.)
(save-excursion
(forward-char 1)
(and (>= (following-char) ?0)
(<= (following-char) ?9))))
(or (and (eq (aref edebug-read-syntax-table (following-char))
'symbol)
(not (= (following-char) ?\;)))
(memq (following-char) '(?\, ?\.)))))
'symbol
(aref edebug-read-syntax-table (following-char))))

2
lisp/emacs-lisp/elp.el
View file

@ -257,7 +257,7 @@ FUNSYM must be a symbol of a defined function."
(setq newguts (append newguts `((elp-wrapper
(quote ,funsym)
,(when (commandp funsym)
'(interactive-p))
'(called-interactively-p))
args))))
;; to record profiling times, we set the symbol's function
;; definition so that it runs the elp-wrapper function with the

2
lisp/emulation/cua-base.el
View file

@ -267,6 +267,7 @@
:group 'editing-basics
:group 'convenience
:group 'emulations
:version "21.4"
:link '(emacs-commentary-link :tag "Commentary" "cua-base.el")
:link '(emacs-library-link :tag "Lisp File" "cua-base.el"))
@ -1338,7 +1339,6 @@ paste (in addition to the normal emacs bindings)."
:set-after '(cua-enable-modeline-indications cua-use-hyper-key)
:require 'cua-base
:link '(emacs-commentary-link "cua-base.el")
:version "21.4"
(setq mark-even-if-inactive t)
(setq highlight-nonselected-windows nil)
(make-variable-buffer-local 'cua--explicit-region-start)

11
lisp/eshell/esh-mode.el
View file

@ -943,10 +943,11 @@ With a prefix argument, narrows region to last command output."
(eshell-bol)
(kill-region (point) here))))
(defun eshell-show-maximum-output ()
"Put the end of the buffer at the bottom of the window."
(interactive)
(if (interactive-p)
(defun eshell-show-maximum-output (&optional interactive)
"Put the end of the buffer at the bottom of the window.
When run interactively, widen the buffer first."
(interactive "p")
(if interactive
(widen))
(goto-char (point-max))
(recenter -1))
@ -1002,7 +1003,7 @@ a key."
(let ((pos (point)))
(if (bobp)
(if (interactive-p)
(error "Buffer too short to truncate"))
(message "Buffer too short to truncate"))
(delete-region (point-min) (point))
(if (interactive-p)
(message "Truncated buffer from %d to %d lines (%.1fk freed)"

2
lisp/fast-lock.el
View file

@ -26,7 +26,7 @@
;;; Commentary:
;; Lazy Lock mode is a Font Lock support mode.
;; Fast Lock mode is a Font Lock support mode.
;; It makes visiting a file in Font Lock mode faster by restoring its face text
;; properties from automatically saved associated Font Lock cache files.
;;

101
lisp/files.el
View file

@ -676,7 +676,7 @@ The truename of a file name is found by chasing symbolic links
both at the level of the file and at the level of the directories
containing it, until no links are left at any level.
\(fn FILENAME)"
\(fn FILENAME)" ;; Don't document the optional arguments.
;; COUNTER and PREV-DIRS are only used in recursive calls.
;; COUNTER can be a cons cell whose car is the count of how many
;; more links to chase before getting an error.
@ -977,6 +977,14 @@ expand wildcards (if any) and visit multiple files."
(mapcar 'switch-to-buffer (cdr value)))
(switch-to-buffer-other-frame value))))
(defun find-file-existing (filename &optional wildcards)
"Edit the existing file FILENAME.
Like \\[find-file] but only allow files that exists."
(interactive (find-file-read-args "Find existing file: " t))
(unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file filename wildcards)
(current-buffer))
(defun find-file-read-only (filename &optional wildcards)
"Edit file FILENAME but don't allow changes.
Like \\[find-file] but marks buffer as read-only.
@ -1225,6 +1233,7 @@ suppresses this warning."
When nil, never request confirmation."
:group 'files
:group 'find-file
:version "21.4"
:type '(choice integer (const :tag "Never request confirmation" nil)))
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
@ -1836,20 +1845,27 @@ be interpreted by the interpreter matched by the second group of the
regular expression. The mode is then determined as the mode associated
with that interpreter in `interpreter-mode-alist'.")
(defvar xml-based-modes '(html-mode)
"Modes that override an XML declaration.
When `set-auto-mode' sees an <?xml or <!DOCTYPE declaration, that
buffer will be in some XML mode. If `auto-mode-alist' associates
the file with one of the modes in this list, that mode will be
used. Else `xml-mode' or `sgml-mode' is used.")
(defvar magic-mode-alist
'(;; The < comes before the groups (but the first) to reduce backtracking.
;; Is there a nicer way of getting . including \n?
;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff.
("\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\)?\\s *\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*[Hh][Tt][Mm][Ll]" . html-mode)
;; These two must come after html, because they are more general:
("<\\?xml " . xml-mode)
("\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*!DOCTYPE " . sgml-mode)
("%![^V]" . ps-mode))
"Alist of buffer beginnings vs corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION). FUNCTION will be
called, unless it is nil.")
(defun set-auto-mode (&optional keep-mode-if-same)
"Select major mode appropriate for current buffer.
This checks for a -*- mode tag in the buffer's text, checks the
interpreter that runs this file against `interpreter-mode-alist',
looks for an <?xml or <!DOCTYPE declaration (see
`xml-based-modes'), or compares the filename against the entries
in `auto-mode-alist'.
compares the buffer beginning against `magic-mode-alist',
or compares the filename against the entries in
`auto-mode-alist'.
It does not check for the `mode:' local variable in the
Local Variables section of the file; for that, use `hack-local-variables'.
@ -1895,7 +1911,8 @@ only set the major mode, if that would change it."
(if (not (functionp mode))
(message "Ignoring unknown mode `%s'" mode)
(setq done t)
(or (set-auto-mode-0 mode)
(or (set-auto-mode-0 mode keep-mode-if-same)
;; continuing would call minor modes again, toggling them off
(throw 'nop nil)))))
;; If we didn't, look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl", which
@ -1909,47 +1926,49 @@ only set the major mode, if that would change it."
;; same time.
done (assoc (file-name-nondirectory mode)
interpreter-mode-alist))
;; If we found an interpreter mode to use, invoke it now.
(if done (set-auto-mode-0 (cdr done))))
(if (and (not done) buffer-file-name)
(let ((name buffer-file-name))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
(while name
;; Find first matching alist entry.
(let ((case-fold-search
(memq system-type '(vax-vms windows-nt cygwin))))
(if (and (setq mode (assoc-default name auto-mode-alist
(if done
(set-auto-mode-0 (cdr done) keep-mode-if-same)))
;; If we found an interpreter mode to use, invoke it now.
(unless done
(if (setq done (save-excursion
(goto-char (point-min))
(assoc-default nil magic-mode-alist
(lambda (re dummy)
(looking-at re)))))
(set-auto-mode-0 done keep-mode-if-same)
(if buffer-file-name
(let ((name buffer-file-name))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
(while name
;; Find first matching alist entry.
(let ((case-fold-search
(memq system-type '(vax-vms windows-nt cygwin))))
(if (and (setq mode (assoc-default name auto-mode-alist
'string-match))
(consp mode)
(cadr mode))
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
(setq name)))
(when mode
(if xml (or (memq mode xml-based-modes)
(setq mode 'xml-mode)))
(set-auto-mode-0 mode)
(setq done t)))))
(and xml
(not done)
(set-auto-mode-0 'xml-mode))))
(consp mode)
(cadr mode))
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
(setq name)))
(when mode
(set-auto-mode-0 mode keep-mode-if-same)))))))))
;; When `keep-mode-if-same' is set, we are working on behalf of
;; set-visited-file-name. In that case, if the major mode specified is the
;; same one we already have, don't actually reset it. We don't want to lose
;; minor modes such as Font Lock.
(defun set-auto-mode-0 (mode)
(defun set-auto-mode-0 (mode &optional keep-mode-if-same)
"Apply MODE and return it.
If `keep-mode-if-same' is non-nil MODE is chased of any aliases and
compared to current major mode. If they are the same, do nothing
and return nil."
If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
any aliases and compared to current major mode. If they are the
same, do nothing and return nil."
(when keep-mode-if-same
(while (symbolp (symbol-function mode))
(setq mode (symbol-function mode)))
(if (eq mode major-mode)
(setq mode)))
(setq mode nil)))
(when mode
(funcall mode)
mode))
@ -3813,7 +3832,7 @@ This command is used in the special Dired buffer created by
(defun kill-some-buffers (&optional list)
"Kill some buffers. Asks the user whether to kill each one of them.
Non-interactively, if optional argument LIST is non-`nil', it
Non-interactively, if optional argument LIST is non-nil, it
specifies the list of buffers to kill, asking for approval for each one."
(interactive)
(if (null list)

3
lisp/filesets.el
View file

@ -295,7 +295,8 @@ key is supported."
(defgroup filesets nil
"The fileset swapper."
:prefix "filesets-"
:group 'convenience)
:group 'convenience
:version "21.4")
(defcustom filesets-menu-name "Filesets"
"*Filesets' menu name."

135
lisp/gnus/ChangeLog
View file

@ -1,5 +1,140 @@
2004-11-04 Richard M. Stallman <rms@gnu.org>
* spam.el (spam group): Add :version.
* pgg-def.el (pgg group): Add :version.
2004-11-04 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art. (gnus-article-edit-article): Don't associate the
article buffer with a draft file. This is a temporary measure
against the 2004-08-22 change to gnus-article-edit-mode.
2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
* html2text.el (html2text-get-attr): Remove unused argument `tag'.
(html2text-format-tags): Remove unused variable `attr'.
* mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of
after-load-alist.
* mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251
entry. From Ilya N. Golubev <gin@mo.msk.ru>.
(mm-enrich-utf-8-by-mule-ucs): New function run when Mule-UCS is
loaded under XEmacs.
(): Don't make duplicated entries in mm-mime-mule-charset-alist.
* mm-util.el (mm-coding-system-p): Return a coding-system.
(mm-mime-mule-charset-alist): Use shift_jis instead of
iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new
entries for the mime charsets iso-2022-jp-3 and shift_jis.
(mm-coding-system-priorities): Use shift_jis and iso-8859-1
instead of japanese-shift-jis and iso-latin-1 respectively in
order to share the default value with both Emacs and XEmacs-mule.
(mm-mule-charset-to-mime-charset): Make
mm-coding-system-priorities effective.
(mm-sort-coding-systems-predicate): Canonicalize coding-systems
while predicating of candidates upon the priorities.
2004-11-01 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-msg.el (gnus-summary-resend-default-address): Add :version.
* tls.el (tls-process-connection-type, tls-success)
(tls-certtool-program): Add :version.
* starttls.el (starttls-gnutls-program, starttls-use-gnutls)
(starttls-extra-arguments, starttls-process-connection-type)
(starttls-connect, starttls-failure, starttls-success):
* spam-stat.el (spam-stat): Add :version.
* sieve.el (sieve): Add :version.
* sha1.el (sha1): Added :version.
(sha1-use-external): Removed redundant version.
* nnmail.el (nnmail-split-fancy-with-parent-ignore-groups)
(nnmail-cache-ignore-groups, nnmail-spool-hook)
(nnmail-split-fancy-match-partial-words)
(nnmail-split-lowercase-expanded):
* nndiary.el (nndiary): Add :version.
* mml2015.el (mml2015-unabbrev-trust-alist): Add :version.
* mml-sec.el (mml-default-sign-method)
(mml-default-encrypt-method, mml-signencrypt-style-alist): Add
:version.
* mm-uu.el (mm-uu-diff-groups-regexp): Add :version.
* mm-url.el (mm-url-use-external, mm-url-program)
(mm-url-arguments): Add :version.
* mm-decode.el (mm-inline-text-html-with-w3m-keymap)
(mm-attachment-file-modes, mm-decrypt-option)
(mm-w3m-safe-url-regexp): Add :version.
* message.el (message-cite-prefix-regexp)
(message-sendmail-envelope-from, message-minibuffer-local-map)
(message-user-fqdn, message-completion-alist): Add :version.
* gnus-win.el (gnus-configure-windows-hook)
(gnus-use-frames-on-any-display): Add :version.
* gnus-art.el (gnus-article-address-banner-alist)
(gnus-treat-unsplit-urls, gnus-treat-unfold-headers)
(gnus-treat-from-picon, gnus-treat-mail-picon)
(gnus-treat-x-pgp-sig): Add :version.
* gnus-sum.el (gnus-spam-mark, gnus-recent-mark)
(gnus-undownloaded-mark, gnus-summary-article-move-hook)
(gnus-summary-article-delete-hook)
(gnus-summary-display-while-building): Add :version.
* gnus-start.el (gnus-subscribe-newsgroup-hooks)
(gnus-get-top-new-news-hook):Add :version.
* gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face)
(gnus-server-closed-face, gnus-server-denied-face): Add :version.
* gnus-registry.el (gnus-registry): Add :version.
* gnus-spec.el (gnus-use-correct-string-widths)
(gnus-make-format-preserve-properties): Add :version.
* gnus.el (gnus-group-charter-alist)
(gnus-group-fetch-control-use-browse-url)
(gnus-install-group-spam-parameters): Add :version.
* gnus-diary.el (gnus-diary): Add :version.
* gnus-delay.el (gnus-delay): Add :version.
* gnus-cite.el (gnus-cite-unsightly-citation-regexp)
(gnus-cite-ignore-quoted-from, gnus-cite-attribution-face)
(gnus-cite-blank-line-after-header, gnus-article-boring-faces):
Add :version.
* gnus-agent.el (gnus-agent-max-fetch-size)
(gnus-agent-enable-expiration, gnus-agent-queue-mail)
(gnus-agent-prompt-send-queue): Add :version.
* deuglify.el (gnus-outlook-deuglify): Add :version.
* html2text.el: Beautify code. Improve doc strings. Some checkdoc
cleanup.
(html2text-get-attr, html2text-fix-paragraph): Simplify code.
(html2text-format-tag-list): Added "strong" and "em". From
"Alfred M. Szmidt" <ams@kemisten.nu> (tiny change).
2004-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-msg.el (gnus-configure-posting-styles): Work with empty
signature file. Suggested by Manoj Srivastava
<srivasta@golden-gryphon.com>.
* mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than
iso-2022-jp even in the Japanese language environment. Suggested
by Jason Rumney <jasonr@gnu.org>.

3
lisp/gnus/deuglify.el
View file

@ -230,7 +230,8 @@
;;; User Customizable Variables:
(defgroup gnus-outlook-deuglify nil
"Deuglify articles generated by broken user agents like MS Outlook (Express).")
"Deuglify articles generated by broken user agents like MS Outlook (Express)."
:version "21.4")
;;;###autoload
(defcustom gnus-outlook-deuglify-unwrap-min 45

4
lisp/gnus/gnus-agent.el
View file

@ -160,6 +160,7 @@ read articles as they would just be downloaded again."
"Chunk size for `gnus-agent-fetch-session'.
The function will split its article fetches into chunks smaller than
this limit."
:version "21.4"
:group 'gnus-agent
:type 'integer)
@ -170,6 +171,7 @@ contents from a group's local storage. This value may be overridden
to disable expiration in specific categories, topics, and groups. Of
course, you could change gnus-agent-enable-expiration to DISABLE then
enable expiration per categories, topics, and groups."
:version "21.4"
:group 'gnus-agent
:type '(radio (const :format "Enable " ENABLE)
(const :format "Disable " DISABLE)))
@ -195,6 +197,7 @@ See Info node `(gnus)Server Buffer'."
"Whether and when outgoing mail should be queued by the agent.
When `always', always queue outgoing mail. When nil, never
queue. Otherwise, queue if and only if unplugged."
:version "21.4"
:group 'gnus-agent
:type '(radio (const :format "Always" always)
(const :format "Never" nil)
@ -203,6 +206,7 @@ queue. Otherwise, queue if and only if unplugged."
(defcustom gnus-agent-prompt-send-queue nil
"If non-nil, `gnus-group-send-queue' will prompt if called when
unplugged."
:version "21.4"
:group 'gnus-agent
:type 'boolean)

11
lisp/gnus/gnus-art.el
View file

@ -318,6 +318,7 @@ advertisements. For example:
(symbol :tag "Item in `gnus-article-banner-alist'" none)
regexp
(const :tag "None" nil))))
:version "21.4"
:group 'gnus-article-washing)
(defcustom gnus-emphasis-alist
@ -920,6 +921,7 @@ See Info node `(gnus)Customizing Articles' for details."
"Remove newlines from within URLs.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:version "21.4"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
@ -1124,6 +1126,7 @@ See Info node `(gnus)Customizing Articles' for details."
"Unfold folded header lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:version "21.4"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
@ -1238,6 +1241,7 @@ See Info node `(gnus)Customizing Articles' and Info node
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
:version "21.4"
:group 'gnus-article-treat
:group 'gnus-picon
:link '(custom-manual "(gnus)Customizing Articles")
@ -1253,6 +1257,7 @@ See Info node `(gnus)Customizing Articles' and Info node
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
:version "21.4"
:group 'gnus-article-treat
:group 'gnus-picon
:link '(custom-manual "(gnus)Customizing Articles")
@ -1338,6 +1343,7 @@ See Info node `(gnus)Customizing Articles' for details."
To automatically treat X-PGP-Sig, set it to head.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:version "21.4"
:group 'gnus-article-treat
:group 'mime-security
:link '(custom-manual "(gnus)Customizing Articles")
@ -5645,7 +5651,10 @@ groups."
"Start editing the contents of the current article buffer."
(let ((winconf (current-window-configuration)))
(set-buffer gnus-article-buffer)
(gnus-article-edit-mode)
(let ((message-auto-save-directory
;; Don't associate the article buffer with a draft file.
nil))
(gnus-article-edit-mode))
(funcall start-func)
(set-buffer-modified-p nil)
(gnus-configure-windows 'edit-article)

5
lisp/gnus/gnus-cite.el
View file

@ -124,6 +124,7 @@ The text matching the first grouping will be used as a button."
(defcustom gnus-cite-unsightly-citation-regexp
"^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
"Regexp matching Microsoft-type rest-of-message citations."
:version "21.4"
:group 'gnus-cite
:type 'regexp)
@ -131,6 +132,7 @@ The text matching the first grouping will be used as a button."
"Non-nil means don't regard lines beginning with \">From \" as cited text.
Those lines may have been quoted by MTAs in order not to mix up with
the envelope From line."
:version "21.4"
:group 'gnus-cite
:type 'boolean)
@ -141,6 +143,7 @@ the envelope From line."
(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
"Face used for attribution lines.
It is merged with the face for the cited text belonging to the attribution."
:version "21.4"
:group 'gnus-cite
:type 'face)
@ -278,7 +281,6 @@ This should make it easier to see who wrote what."
(defcustom gnus-cite-blank-line-after-header t
"If non-nil, put a blank line between the citation header and the button."
:version "21.4"
:group 'gnus-cite
:type 'boolean)
@ -290,7 +292,6 @@ This should make it easier to see who wrote what."
If an article has more pages below the one you are looking at, but
nothing on those pages is a word of at least three letters that is not
in a boring face, then the pages will be skipped."
:version "21.4"
:type '(repeat face)
:group 'gnus-article-hiding)

1
lisp/gnus/gnus-delay.el
View file

@ -41,6 +41,7 @@
;;;###autoload
(defgroup gnus-delay nil
"Arrange for sending postings later."
:version "21.4"
:group 'gnus)
(defcustom gnus-delay-group "delayed"

3
lisp/gnus/gnus-diary.el
View file

@ -102,7 +102,8 @@
(require 'gnus-art)
(defgroup gnus-diary nil
"Utilities on top of the nndiary backend for Gnus.")
"Utilities on top of the nndiary backend for Gnus."
:version "21.4")
(defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n"
"*Summary line format for nndiary groups."

6
lisp/gnus/gnus-msg.el
View file

@ -281,6 +281,7 @@ If nil, Gnus will never ask for confirmation if replying to mail."
"If non-nil, Gnus tries to suggest a default address to resend to.
If nil, the address field will always be empty after invoking
`gnus-summary-resend-message'."
:version "21.4"
:group 'gnus-message
:type 'boolean)
@ -1871,8 +1872,9 @@ this is a reply."
(setq v (with-temp-buffer
(insert-file-contents v)
(goto-char (point-max))
(while (bolp)
(delete-char -1))
(skip-chars-backward "\n")
(delete-region (+ (point) (if (bolp) 0 1))
(point-max))
(buffer-string))))
(setq results (delq (assoc element results) results))
(push (cons element v) results))))

1
lisp/gnus/gnus-registry.el
View file

@ -66,6 +66,7 @@
(defgroup gnus-registry nil
"The Gnus registry."
:version "21.4"
:group 'gnus)
(defvar gnus-registry-hashtb nil

2
lisp/gnus/gnus-spec.el
View file

@ -32,12 +32,14 @@
(defcustom gnus-use-correct-string-widths (featurep 'xemacs)
"*If non-nil, use correct functions for dealing with wide characters."
:version "21.4"
:group 'gnus-format
:type 'boolean)
(defcustom gnus-make-format-preserve-properties (featurep 'xemacs)
"*If non-nil, use a replacement `format' function which preserves
text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
:version "21.4"
:group 'gnus-format
:type 'boolean)

4
lisp/gnus/gnus-srvr.el
View file

@ -205,21 +205,25 @@ If nil, a faster, but more primitive, buffer is used instead."
(defcustom gnus-server-agent-face 'gnus-server-agent-face
"Face name to use on AGENTIZED servers."
:version "21.4"
:group 'gnus-server-visual
:type 'face)
(defcustom gnus-server-opened-face 'gnus-server-opened-face
"Face name to use on OPENED servers."
:version "21.4"
:group 'gnus-server-visual
:type 'face)
(defcustom gnus-server-closed-face 'gnus-server-closed-face
"Face name to use on CLOSED servers."
:version "21.4"
:group 'gnus-server-visual
:type 'face)
(defcustom gnus-server-denied-face 'gnus-server-denied-face
"Face name to use on DENIED servers."
:version "21.4"
:group 'gnus-server-visual
:type 'face)

2
lisp/gnus/gnus-start.el
View file

@ -299,6 +299,7 @@ claim them."
(defcustom gnus-subscribe-newsgroup-hooks nil
"*Hooks run after you subscribe to a new group.
The hooks will be called with new group's name as argument."
:version "21.4"
:group 'gnus-group-new
:type 'hook)
@ -405,6 +406,7 @@ This hook is called as the first thing when Gnus is started."
(defcustom gnus-get-top-new-news-hook nil
"A hook run just before Gnus checks for new news globally."
:version "21.4"
:group 'gnus-group-new
:type 'hook)

7
lisp/gnus/gnus-sum.el
View file

@ -469,6 +469,7 @@ this variable specifies group names."
(defcustom gnus-spam-mark ?$
"*Mark used for spam articles."
:version "21.4"
:group 'gnus-summary-marks
:type 'character)
@ -505,6 +506,7 @@ this variable specifies group names."
(defcustom gnus-recent-mark ?N
"*Mark used for articles that are recent."
:version "21.4"
:group 'gnus-summary-marks
:type 'character)
@ -552,6 +554,7 @@ this variable specifies group names."
(defcustom gnus-undownloaded-mark ?-
"*Mark used for articles that weren't downloaded."
:version "21.4"
:group 'gnus-summary-marks
:type 'character)
@ -890,16 +893,19 @@ automatically when it is selected."
(defcustom gnus-summary-article-move-hook nil
"*A hook called after an article is moved, copied, respooled, or crossposted."
:version "21.4"
:group 'gnus-summary
:type 'hook)
(defcustom gnus-summary-article-delete-hook nil
"*A hook called after an article is deleted."
:version "21.4"
:group 'gnus-summary
:type 'hook)
(defcustom gnus-summary-article-expire-hook nil
"*A hook called after an article is expired."
:version "21.4"
:group 'gnus-summary
:type 'hook)
@ -9178,6 +9184,7 @@ If nil, use to the current newsgroup method."
"If non-nil, show and update the summary buffer as it's being built.
If the value is t, update the buffer after every line is inserted. If
the value is an integer (N), update the display every N lines."
:version "21.4"
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
number

2
lisp/gnus/gnus-win.el
View file

@ -62,6 +62,7 @@
"*If non-nil, frames on all displays will be considered useable by Gnus.
When nil, only frames on the same display as the selected frame will be
used to display Gnus windows."
:version "21.4"
:group 'gnus-windows
:type 'boolean)
@ -198,6 +199,7 @@ See the Gnus manual for an explanation of the syntax used.")
(defcustom gnus-configure-windows-hook nil
"*A hook called when configuring windows."
:version "21.4"
:group 'gnus-windows
:type 'hook)

3
lisp/gnus/gnus.el
View file

@ -1314,6 +1314,7 @@ If the default site is too slow, try one of these:
(gnus-replace-in-string name "\\." "-") "-charter.html")))
"*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter.
When FORM is evaluated `name' is bound to the name of the group."
:version "21.4"
:group 'gnus-group-various
:type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
@ -1321,6 +1322,7 @@ When FORM is evaluated `name' is bound to the name of the group."
"*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 "21.4"
:group 'gnus-group-various
:type 'boolean)
@ -1788,6 +1790,7 @@ total number of articles in the group.")
(defcustom gnus-install-group-spam-parameters t
"*Disable the group parameters for spam detection.
Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report."
:version "21.4"
:type 'boolean
:group 'gnus-start)

244
lisp/gnus/html2text.el
View file

@ -24,11 +24,11 @@
;; These functions provide a simple way to wash/clean html infected
;; mails. Definitely do not work in all cases, but some improvement
;; in readability is generally obtained. Formatting is only done in
;; in readability is generally obtained. Formatting is only done in
;; the buffer, so the next time you enter the article it will be
;; "re-htmlized".
;;
;; The main function is "html2text"
;; The main function is `html2text'.
;;; Code:
@ -47,9 +47,9 @@
"The map of entity to text.
This is an alist were each element is a dotted pair consisting of an
old string, and a replacement string. This replacement is done by the
function \"html2text-substitute\" which basically performs a
replace-string operation for every element in the list. This is
old string, and a replacement string. This replacement is done by the
function `html2text-substitute' which basically performs a
`replace-string' operation for every element in the list. This is
completely verbatim - without any use of REGEXP.")
(defvar html2text-remove-tag-list
@ -57,11 +57,11 @@ completely verbatim - without any use of REGEXP.")
"A list of removable tags.
This is a list of tags which should be removed, without any
formatting. Observe that if you the tags in the list are presented
*without* any \"<\" or \">\". All occurences of a tag appearing in
this list are removed, irrespective of whether it is a closing or
opening tag, or if the tag has additional attributes. The actual
deletion is done by the function \"html2text-remove-tags\".
formatting. Note that tags in the list are presented *without*
any \"<\" or \">\". All occurences of a tag appearing in this
list are removed, irrespective of whether it is a closing or
opening tag, or if the tag has additional attributes. The
deletion is done by the function `html2text-remove-tags'.
For instance the text:
@ -75,8 +75,10 @@ If this list contains the element \"font\".")
(defvar html2text-format-tag-list
'(("b" . html2text-clean-bold)
("strong" . html2text-clean-bold)
("u" . html2text-clean-underline)
("i" . html2text-clean-italic)
("em" . html2text-clean-italic)
("blockquote" . html2text-clean-blockquote)
("a" . html2text-clean-anchor)
("ul" . html2text-clean-ul)
@ -86,7 +88,7 @@ If this list contains the element \"font\".")
"An alist of tags and processing functions.
This is an alist where each dotted pair consists of a tag, and then
the name of a function to be called when this tag is found. The
the name of a function to be called when this tag is found. The
function is called with the arguments p1, p2, p3 and p4. These are
demontrated below:
@ -117,17 +119,15 @@ formatting, and then moved afterward.")
;;
(defun html2text-replace-string (from-string to-string p1 p2)
(goto-char p1)
(defun html2text-replace-string (from-string to-string min max)
"Replace FROM-STRING with TO-STRING in region from MIN to MAX."
(goto-char min)
(let ((delta (- (string-width to-string) (string-width from-string)))
(change 0))
(while (search-forward from-string p2 t)
(while (search-forward from-string max t)
(replace-match to-string)
(setq change (+ change delta))
)
change
)
)
(setq change (+ change delta)))
change))
;;
;; </Utility functions>
@ -140,11 +140,11 @@ formatting, and then moved afterward.")
;; <Functions related to attributes> i.e. <font size=+3>
;;
(defun html2text-attr-value (attr-list attr)
(nth 1 (assoc attr attr-list))
)
(defun html2text-attr-value (list attribute)
"Get value of ATTRIBUTE from LIST."
(nth 1 (assoc attribute list)))
(defun html2text-get-attr (p1 p2 tag)
(defun html2text-get-attr (p1 p2)
(goto-char p1)
(re-search-forward " +[^ ]" p2 t)
(let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2)))
@ -161,14 +161,10 @@ formatting, and then moved afterward.")
((string-match "[^ ]=[^ ]" prev)
(let ((attr (nth 0 (split-string prev "=")))
(value (nth 1 (split-string prev "="))))
(setq attr-list (cons (list attr value) attr-list))
)
)
(setq attr-list (cons (list attr value) attr-list))))
;; size= 3
((string-match "[^ ]=\\'" prev)
(setq attr-list (cons (list (substring prev 0 -1) this) attr-list))
)
)
(setq attr-list (cons (list (substring prev 0 -1) this) attr-list))))
(while (< index (length tmp-list))
(cond
@ -176,29 +172,20 @@ formatting, and then moved afterward.")
((string-match "[^ ]=[^ ]" this)
(let ((attr (nth 0 (split-string this "=")))
(value (nth 1 (split-string this "="))))
(setq attr-list (cons (list attr value) attr-list))
)
)
(setq attr-list (cons (list attr value) attr-list))))
;; size =3
((string-match "\\`=[^ ]" this)
(setq attr-list (cons (list prev (substring this 1)) attr-list)))
;; size= 3
((string-match "[^ ]=\\'" this)
(setq attr-list (cons (list (substring this 0 -1) next) attr-list))
)
(setq attr-list (cons (list (substring this 0 -1) next) attr-list)))
;; size = 3
((string= "=" this)
(setq attr-list (cons (list prev next) attr-list))
)
)
(setq attr-list (cons (list prev next) attr-list))))
(setq index (1+ index))
(setq prev this)
(setq this next)
(setq next (nth (1+ index) tmp-list))
)
(setq next (nth (1+ index) tmp-list)))
;;
;; Tags with no accompanying "=" i.e. value=nil
;;
@ -207,41 +194,25 @@ formatting, and then moved afterward.")
(setq next (nth 2 tmp-list))
(setq index 1)
(if (not (string-match "=" prev))
(progn
(if (not (string= (substring this 0 1) "="))
(setq attr-list (cons (list prev nil) attr-list))
)
)
)
(when (and (not (string-match "=" prev))
(not (string= (substring this 0 1) "=")))
(setq attr-list (cons (list prev nil) attr-list)))
(while (< index (1- (length tmp-list)))
(if (not (string-match "=" this))
(if (not (or (string= (substring next 0 1) "=")
(string= (substring prev -1) "=")))
(setq attr-list (cons (list this nil) attr-list))
)
)
(when (and (not (string-match "=" this))
(not (or (string= (substring next 0 1) "=")
(string= (substring prev -1) "="))))
(setq attr-list (cons (list this nil) attr-list)))
(setq index (1+ index))
(setq prev this)
(setq this next)
(setq next (nth (1+ index) tmp-list))
)
(setq next (nth (1+ index) tmp-list)))
(if this
(progn
(if (not (string-match "=" this))
(progn
(if (not (string= (substring prev -1) "="))
(setq attr-list (cons (list this nil) attr-list))
)
)
)
)
)
attr-list ;; return - value
)
)
(when (and this
(not (string-match "=" this))
(not (string= (substring prev -1) "=")))
(setq attr-list (cons (list this nil) attr-list)))
;; return - value
attr-list))
;;
;; </Functions related to attributes>
@ -266,10 +237,7 @@ formatting, and then moved afterward.")
(cond
((string= list-type "ul") (insert " o "))
((string= list-type "ol") (insert (format " %s: " item-nr)))
(t (insert " x ")))
)
)
)
(t (insert " x "))))))
(defun html2text-clean-dtdd (p1 p2)
(goto-char p1)
@ -308,61 +276,51 @@ formatting, and then moved afterward.")
(html2text-delete-single-tag p1 p2)
(goto-char p1)
(newline 1)
(insert (make-string fill-column ?-))
)
(insert (make-string fill-column ?-)))
(defun html2text-clean-ul (p1 p2 p3 p4)
(html2text-delete-tags p1 p2 p3 p4)
(html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul")
)
(html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul"))
(defun html2text-clean-ol (p1 p2 p3 p4)
(html2text-delete-tags p1 p2 p3 p4)
(html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol")
)
(html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol"))
(defun html2text-clean-dl (p1 p2 p3 p4)
(html2text-delete-tags p1 p2 p3 p4)
(html2text-clean-dtdd p1 (- p3 (- p1 p2)))
)
(html2text-clean-dtdd p1 (- p3 (- p1 p2))))
(defun html2text-clean-center (p1 p2 p3 p4)
(html2text-delete-tags p1 p2 p3 p4)
(center-region p1 (- p3 (- p2 p1)))
)
(center-region p1 (- p3 (- p2 p1))))
(defun html2text-clean-bold (p1 p2 p3 p4)
(put-text-property p2 p3 'face 'bold)
(html2text-delete-tags p1 p2 p3 p4)
)
(html2text-delete-tags p1 p2 p3 p4))
(defun html2text-clean-title (p1 p2 p3 p4)
(put-text-property p2 p3 'face 'bold)
(html2text-delete-tags p1 p2 p3 p4)
)
(html2text-delete-tags p1 p2 p3 p4))
(defun html2text-clean-underline (p1 p2 p3 p4)
(put-text-property p2 p3 'face 'underline)
(html2text-delete-tags p1 p2 p3 p4)
)
(html2text-delete-tags p1 p2 p3 p4))
(defun html2text-clean-italic (p1 p2 p3 p4)
(put-text-property p2 p3 'face 'italic)
(html2text-delete-tags p1 p2 p3 p4)
)
(html2text-delete-tags p1 p2 p3 p4))
(defun html2text-clean-font (p1 p2 p3 p4)
(html2text-delete-tags p1 p2 p3 p4)
)
(html2text-delete-tags p1 p2 p3 p4))
(defun html2text-clean-blockquote (p1 p2 p3 p4)
(html2text-delete-tags p1 p2 p3 p4)
)
(html2text-delete-tags p1 p2 p3 p4))
(defun html2text-clean-anchor (p1 p2 p3 p4)
;; If someone can explain how to make the URL clickable I will
;; surely improve upon this.
(let* ((attr-list (html2text-get-attr p1 p2 "a"))
;; If someone can explain how to make the URL clickable I will surely
;; improve upon this.
;; Maybe `goto-addr.el' can be used here.
(let* ((attr-list (html2text-get-attr p1 p2))
(href (html2text-attr-value attr-list "href")))
(delete-region p1 p4)
(when href
@ -386,38 +344,27 @@ formatting, and then moved afterward.")
(let ((has-br-line)
(refill-start)
(refill-stop))
(if (re-search-forward "<br>$" p2 t)
(setq has-br-line t)
)
(if has-br-line
(progn
(goto-char p1)
(if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t)
(progn
(beginning-of-line)
(setq refill-start (point))
(goto-char p2)
(re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
(next-line 1)
(end-of-line)
;; refill-stop should ideally be adjusted to
;; accomodate the "<br>" strings which are removed
;; between refill-start and refill-stop. Can simply
;; be returned from my-replace-string
(setq refill-stop (+ (point)
(html2text-replace-string
"<br>" ""
refill-start (point))))
;; (message "Point = %s refill-stop = %s" (point) refill-stop)
;; (sleep-for 4)
(fill-region refill-start refill-stop)
)
)
)
)
)
(html2text-replace-string "<br>" "" p1 p2)
)
(when (re-search-forward "<br>$" p2 t)
(goto-char p1)
(when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t)
(beginning-of-line)
(setq refill-start (point))
(goto-char p2)
(re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
(next-line 1)
(end-of-line)
;; refill-stop should ideally be adjusted to
;; accomodate the "<br>" strings which are removed
;; between refill-start and refill-stop. Can simply
;; be returned from my-replace-string
(setq refill-stop (+ (point)
(html2text-replace-string
"<br>" ""
refill-start (point))))
;; (message "Point = %s refill-stop = %s" (point) refill-stop)
;; (sleep-for 4)
(fill-region refill-start refill-stop))))
(html2text-replace-string "<br>" "" p1 p2))
;;
;; This one is interactive ...
@ -452,7 +399,7 @@ fashion, quite close to pure guess-work. It does work in some cases though."
;;
(defun html2text-remove-tags (tag-list)
"Removes the tags listed in the list \"html2text-remove-tag-list\".
"Removes the tags listed in the list `html2text-remove-tag-list'.
See the documentation for that variable."
(interactive)
(dolist (tag tag-list)
@ -461,7 +408,7 @@ See the documentation for that variable."
(delete-region (match-beginning 0) (match-end 0)))))
(defun html2text-format-tags ()
"See the variable \"html2text-format-tag-list\" for documentation"
"See the variable `html2text-format-tag-list' for documentation."
(interactive)
(dolist (tag-and-function html2text-format-tag-list)
(let ((tag (car tag-and-function))
@ -471,8 +418,7 @@ See the documentation for that variable."
(point-max) t)
(let ((p1)
(p2 (point))
(p3) (p4)
(attr (match-string 1)))
(p3) (p4))
(search-backward "<" (point-min) t)
(setq p1 (point))
(re-search-forward (format "</%s>" tag) (point-max) t)
@ -480,27 +426,18 @@ See the documentation for that variable."
(search-backward "</" (point-min) t)
(setq p3 (point))
(funcall function p1 p2 p3 p4)
(goto-char p1)
)
)
)
)
)
(goto-char p1))))))
(defun html2text-substitute ()
"See the variable \"html2text-replace-list\" for documentation"
"See the variable `html2text-replace-list' for documentation."
(interactive)
(dolist (e html2text-replace-list)
(goto-char (point-min))
(let ((old-string (car e))
(new-string (cdr e)))
(html2text-replace-string old-string new-string (point-min) (point-max))
)
)
)
(html2text-replace-string old-string new-string (point-min) (point-max)))))
(defun html2text-format-single-elements ()
""
(interactive)
(dolist (tag-and-function html2text-format-single-element-list)
(let ((tag (car tag-and-function))
@ -512,12 +449,7 @@ See the documentation for that variable."
(p2 (point)))
(search-backward "<" (point-min) t)
(setq p1 (point))
(funcall function p1 p2)
)
)
)
)
)
(funcall function p1 p2))))))
;;
;; Main function
@ -540,6 +472,6 @@ See the documentation for that variable."
;;
;; </Interactive functions>
;;
(provide 'html2text)
;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e
;;; html2text.el ends here

7
lisp/gnus/message.el
View file

@ -587,6 +587,7 @@ Done before generating the new subject of a forward."
non-word-constituents
"]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
"*Regexp matching the longest possible citation prefix on a line."
:version "21.4"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
:type 'regexp)
@ -743,6 +744,7 @@ Doing so would be even more evil than leaving it out."
"*Envelope-from when sending mail with sendmail.
If this is nil, use `user-mail-address'. If it is the symbol
`header', use the From: header of the message."
:version "21.4"
:type '(choice (string :tag "From name")
(const :tag "Use From: header from message" header)
(const :tag "Use `user-mail-address'" nil))
@ -855,7 +857,8 @@ the signature is inserted."
(let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
(set-keymap-parent map minibuffer-local-map)
map)
"Keymap for `message-read-from-minibuffer'.")
"Keymap for `message-read-from-minibuffer'."
:version "21.4")
;;;###autoload
(defcustom message-citation-line-function 'message-insert-citation-line
@ -1435,6 +1438,7 @@ no, only reply back to the author."
(defcustom message-user-fqdn nil
"*Domain part of Messsage-Ids."
:version "21.4"
:group 'message-headers
:link '(custom-manual "(message)News Headers")
:type '(radio (const :format "%v " nil)
@ -6590,6 +6594,7 @@ which specify the range to operate on."
'("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
. message-expand-name))
"Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
:version "21.4"
:group 'message
:type '(alist :key-type regexp :value-type function))

4
lisp/gnus/mm-decode.el
View file

@ -150,12 +150,14 @@ when displaying the image. The default value is \"\\\\`cid:\" which only
matches parts embedded to the Multipart/Related type MIME contents and
Gnus will never connect to the spammer's site arbitrarily. You may
set this variable to nil if you consider all urls to be safe."
:version "21.4"
:type '(choice (regexp :tag "Regexp")
(const :tag "All URLs are safe" nil))
:group 'mime-display)
(defcustom mm-inline-text-html-with-w3m-keymap t
"If non-nil, use emacs-w3m command keys in the article buffer."
:version "21.4"
:type 'boolean
:group 'mime-display)
@ -378,6 +380,7 @@ If not set, `default-directory' will be used."
(defcustom mm-attachment-file-modes 384
"Set the mode bits of saved attachments to this integer."
:version "21.4"
:type 'integer
:group 'mime-display)
@ -435,6 +438,7 @@ If not set, `default-directory' will be used."
"Option of decrypting encrypted parts.
`never', not decrypt; `always', always decrypt;
`known', only decrypt known protocols. Otherwise, ask user."
:version "21.4"
:type '(choice (item always)
(item never)
(item :tag "only known protocols" known)

3
lisp/gnus/mm-url.el
View file

@ -49,6 +49,7 @@
(require 'url)
(error nil)))
"*If non-nil, use external grab program `mm-url-program'."
:version "21.4"
:type 'boolean
:group 'mm-url)
@ -67,6 +68,7 @@
(t "GET"))
"The url grab program.
Likely values are `wget', `w3m', `lynx' and `curl'."
:version "21.4"
:type '(choice
(symbol :tag "wget" wget)
(symbol :tag "w3m" w3m)
@ -77,6 +79,7 @@ Likely values are `wget', `w3m', `lynx' and `curl'."
(defcustom mm-url-arguments nil
"The arguments for `mm-url-program'."
:version "21.4"
:type '(repeat string)
:group 'mm-url)

106
lisp/gnus/mm-util.el
View file

@ -123,13 +123,16 @@
(defun mm-coding-system-p (cs)
"Return non-nil if CS is a symbol naming a coding system.
In XEmacs, also return non-nil if CS is a coding system object."
In XEmacs, also return non-nil if CS is a coding system object.
If CS is available, return CS itself in Emacs, and return a coding
system object in XEmacs."
(if (fboundp 'find-coding-system)
(find-coding-system cs)
(if (fboundp 'coding-system-p)
(coding-system-p cs)
(when (coding-system-p cs)
cs)
;; Is this branch ever actually useful?
(memq cs (mm-get-coding-system-list)))))
(car (memq cs (mm-get-coding-system-list))))))
(defvar mm-charset-synonym-alist
`(
@ -219,12 +222,12 @@ In XEmacs, also return non-nil if CS is a coding system object."
(big5 chinese-big5-1 chinese-big5-2)
(tibetan tibetan)
(thai-tis620 thai-tis620)
(windows-1251 cyrillic-iso8859-5)
(iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
(iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
latin-jisx0201 japanese-jisx0208-1978
chinese-gb2312 japanese-jisx0208
korean-ksc5601 japanese-jisx0212
katakana-jisx0201)
korean-ksc5601 japanese-jisx0212)
(iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
latin-jisx0201 japanese-jisx0208-1978
chinese-gb2312 japanese-jisx0208
@ -239,6 +242,9 @@ In XEmacs, also return non-nil if CS is a coding system object."
chinese-cns11643-3 chinese-cns11643-4
chinese-cns11643-5 chinese-cns11643-6
chinese-cns11643-7)
(iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
japanese-jisx0213-1 japanese-jisx0213-2)
(shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
,(if (or (not (fboundp 'charsetp)) ;; non-Mule case
(charsetp 'unicode-a)
(not (mm-coding-system-p 'mule-utf-8)))
@ -249,24 +255,47 @@ In XEmacs, also return non-nil if CS is a coding system object."
(coding-system-get 'mule-utf-8 'safe-charsets)))))
"Alist of MIME-charset/MULE-charsets.")
;; Correct by construction, but should be unnecessary:
;; XEmacs hates it.
(when (and (not (featurep 'xemacs))
(fboundp 'coding-system-list)
(fboundp 'sort-coding-systems))
(setq mm-mime-mule-charset-alist
(apply
'nconc
(mapcar
(lambda (cs)
(when (and (or (coding-system-get cs :mime-charset) ; Emacs 22
(coding-system-get cs 'mime-charset))
(not (eq t (coding-system-get cs 'safe-charsets))))
(list (cons (or (coding-system-get cs :mime-charset)
(coding-system-get cs 'mime-charset))
(delq 'ascii
(coding-system-get cs 'safe-charsets))))))
(sort-coding-systems (coding-system-list 'base-only))))))
(defun mm-enrich-utf-8-by-mule-ucs ()
"Make the `utf-8' MIME charset usable by the Mule-UCS package.
This function will run when the `un-define' module is loaded under
XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist'
with Mule charsets. It is completely useless for Emacs."
(unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs)
(assoc "un-define" after-load-alist)))
(setq after-load-alist
(delete '("un-define") after-load-alist)))
(when (boundp 'unicode-basic-translation-charset-order-list)
(condition-case nil
(let ((val (delq
'ascii
(copy-sequence
(symbol-value
'unicode-basic-translation-charset-order-list))))
(elem (assq 'utf-8 mm-mime-mule-charset-alist)))
(if elem
(setcdr elem val)
(setq mm-mime-mule-charset-alist
(nconc mm-mime-mule-charset-alist
(list (cons 'utf-8 val))))))
(error))))
;; Correct by construction, but should be unnecessary for Emacs:
(if (featurep 'xemacs)
(eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs))
(when (and (fboundp 'coding-system-list)
(fboundp 'sort-coding-systems))
(let ((css (sort-coding-systems (coding-system-list 'base-only)))
cs mime mule alist)
(while css
(setq cs (pop css)
mime (or (coding-system-get cs :mime-charset) ; Emacs 22
(coding-system-get cs 'mime-charset)))
(when (and mime
(not (eq t (setq mule
(coding-system-get cs 'safe-charsets))))
(not (assq mime alist)))
(push (cons mime (delq 'ascii mule)) alist)))
(setq mm-mime-mule-charset-alist (nreverse alist)))))
(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
"A list of special charsets.
@ -332,16 +361,20 @@ mail with multiple parts is preferred to sending a Unicode one.")
"Return the MIME charset corresponding to the given Mule CHARSET."
(if (and (fboundp 'find-coding-systems-for-charsets)
(fboundp 'sort-coding-systems))
(let (mime)
(dolist (cs (sort-coding-systems
(copy-sequence
(find-coding-systems-for-charsets (list charset)))))
(unless mime
(when cs
(setq mime (or (coding-system-get cs :mime-charset)
(coding-system-get cs 'mime-charset))))))
(let ((css (sort (sort-coding-systems
(find-coding-systems-for-charsets (list charset)))
'mm-sort-coding-systems-predicate))
cs mime)
(while (and (not mime)
css)
(when (setq cs (pop css))
(setq mime (or (coding-system-get cs :mime-charset)
(coding-system-get cs 'mime-charset)))))
mime)
(let ((alist mm-mime-mule-charset-alist)
(let ((alist (mapcar (lambda (cs)
(assq cs mm-mime-mule-charset-alist))
(sort (mapcar 'car mm-mime-mule-charset-alist)
'mm-sort-coding-systems-predicate)))
out)
(while alist
(when (memq charset (cdar alist))
@ -534,11 +567,14 @@ This affects whether coding conversion should be attempted generally."
(let ((priorities
(mapcar (lambda (cs)
;; Note: invalid entries are dropped silently
(and (coding-system-p cs)
(and (setq cs (mm-coding-system-p cs))
(coding-system-base cs)))
mm-coding-system-priorities)))
(> (length (memq a priorities))
(length (memq b priorities)))))
(and (setq a (mm-coding-system-p a))
(if (setq b (mm-coding-system-p b))
(> (length (memq (coding-system-base a) priorities))
(length (memq (coding-system-base b) priorities)))
t))))
(defun mm-find-mime-charset-region (b e &optional hack-charsets)
"Return the MIME charsets needed to encode the region between B and E.

1
lisp/gnus/mm-uu.el
View file

@ -80,6 +80,7 @@ This can be either \"inline\" or \"attachment\".")
(defcustom mm-uu-diff-groups-regexp "gnus\\.commits"
"*Regexp matching diff groups."
:version "21.4"
:type 'regexp
:group 'gnus-article-mime)

3
lisp/gnus/mml-sec.el
View file

@ -43,6 +43,7 @@
(defcustom mml-default-sign-method "pgpmime"
"Default sign method.
The string must have an entry in `mml-sign-alist'."
:version "21.4"
:type '(choice (const "smime")
(const "pgp")
(const "pgpauto")
@ -60,6 +61,7 @@ The string must have an entry in `mml-sign-alist'."
(defcustom mml-default-encrypt-method "pgpmime"
"Default encryption method.
The string must have an entry in `mml-encrypt-alist'."
:version "21.4"
:type '(choice (const "smime")
(const "pgp")
(const "pgpauto")
@ -83,6 +85,7 @@ Note that the output generated by using a `combined' mode is NOT
understood by all PGP implementations, in particular PGP version
2 does not support it! See Info node `(message)Security' for
details."
:version "21.4"
:group 'message
:type '(repeat (list (choice (const :tag "S/MIME" "smime")
(const :tag "PGP" "pgp")

1
lisp/gnus/mml2015.el
View file

@ -83,6 +83,7 @@
("TRUST_FULLY" . t)
("TRUST_ULTIMATE" . t))
"Map GnuPG trust output values to a boolean saying if you trust the key."
:version "21.4"
:group 'mime-security
:type '(repeat (cons (regexp :tag "GnuPG output regexp")
(boolean :tag "Trust key"))))

1
lisp/gnus/nndiary.el
View file

@ -223,6 +223,7 @@
(defgroup nndiary nil
"The Gnus Diary backend."
:version "21.4"
:group 'gnus-diary)
(defcustom nndiary-mail-sources

5
lisp/gnus/nnmail.el
View file

@ -119,6 +119,7 @@ If nil, the first match found will be used."
(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
"Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
This can also be a list of regexps."
:version "21.4"
:group 'nnmail-split
:type '(choice (const :tag "none" nil)
(regexp :value ".*")
@ -127,6 +128,7 @@ This can also be a list of regexps."
(defcustom nnmail-cache-ignore-groups nil
"Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
This can also be a list of regexps."
:version "21.4"
:group 'nnmail-split
:type '(choice (const :tag "none" nil)
(regexp :value ".*")
@ -353,6 +355,7 @@ discarded after running the split process."
(defcustom nnmail-spool-hook nil
"*A hook called when a new article is spooled."
:version "21.4"
:group 'nnmail
:type 'hook)
@ -575,6 +578,7 @@ Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\
surrounded
by anything."
:version "21.4"
:group 'nnmail
:type 'boolean)
@ -582,6 +586,7 @@ by anything."
"Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
This avoids the creation of multiple groups when users send to an address
using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
:version "21.4"
:group 'nnmail
:type 'boolean)

3
lisp/gnus/pgg-def.el
View file

@ -29,7 +29,8 @@
(defgroup pgg ()
"Glue for the various PGP implementations."
:group 'mime)
:group 'mime
:version "21.4")
(defcustom pgg-default-scheme 'gpg
"Default PGP scheme."

2
lisp/gnus/sha1.el
View file

@ -60,6 +60,7 @@
(defgroup sha1 nil
"Elisp interface for SHA1 hash computation."
:version "21.4"
:group 'extensions)
(defcustom sha1-maximum-internal-length 500
@ -82,7 +83,6 @@ It must be a string \(program name\) or list of strings \(name and its args\)."
(error))
"*Use external SHA1 program.
If this variable is set to nil, use internal function only."
:version "21.4"
:type 'boolean
:group 'sha1)

1
lisp/gnus/sieve.el
View file

@ -65,6 +65,7 @@
(defgroup sieve nil
"Manage sieve scripts."
:version "21.4"
:group 'tools)
(defcustom sieve-new-script "<new script>"

1
lisp/gnus/spam-stat.el
View file

@ -128,6 +128,7 @@
Use the functions to build a dictionary of words and their statistical
distribution in spam and non-spam mails. Then use a function to determine
whether a buffer contains spam or not."
:version "21.4"
:group 'gnus)
(defcustom spam-stat-file "~/.spam-stat.el"

3
lisp/gnus/spam.el
View file

@ -76,7 +76,8 @@
;;; Main parameters.
(defgroup spam nil
"Spam configuration.")
"Spam configuration."
:version "21.4")
(defcustom spam-directory (nnheader-concat gnus-directory "spam/")
"Directory for spam whitelists and blacklists."

7
lisp/gnus/starttls.el
View file

@ -126,6 +126,7 @@
"Name of GNUTLS command line tool.
This program is used when GNUTLS is used, i.e. when
`starttls-use-gnutls' is non-nil."
:version "21.4"
:type 'string
:group 'starttls)
@ -138,6 +139,7 @@ i.e. when `starttls-use-gnutls' is nil."
(defcustom starttls-use-gnutls (not (executable-find starttls-program))
"*Whether to use GNUTLS instead of the `starttls' command."
:version "21.4"
:type 'boolean
:group 'starttls)
@ -156,11 +158,13 @@ This program is used when GNUTLS is used, i.e. when
For example, non-TLS compliant servers may require
'(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to
find out which parameters are available."
:version "21.4"
:type '(repeat string)
:group 'starttls)
(defcustom starttls-process-connection-type nil
"*Value for `process-connection-type' to use when starting STARTTLS process."
:version "21.4"
:type 'boolean
:group 'starttls)
@ -170,6 +174,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs."
;; GNUTLS cli.c:main() print this string when it is starting to run
;; in the application read/write phase. If the logic, or the string
;; itself, is modified, this must be updated.
:version "21.4"
:type 'regexp
:group 'starttls)
@ -178,6 +183,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs."
The default is what GNUTLS's \"gnutls-cli\" outputs."
;; GNUTLS cli.c:do_handshake() print this string on failure. If the
;; logic, or the string itself, is modified, this must be updated.
:version "21.4"
:type 'regexp
:group 'starttls)
@ -188,6 +194,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs."
;; common.c:print_info(), that unconditionally print this string
;; last. If that logic, or the string itself, is modified, this
;; must be updated.
:version "21.4"
:type 'regexp
:group 'starttls)

23
lisp/help-at-pt.el
View file

@ -1,6 +1,6 @@
;;; help-at-pt.el --- local help through the keyboard
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;; Author: Luc Teirlinck <teirllm@auburn.edu>
;; Keywords: help
@ -98,6 +98,13 @@ mainly meant for use from Lisp."
(message "%s" help)
(if (not arg) (message "No local help at point")))))
(defvar help-at-pt-timer nil
"Non-nil means that a timer is set that checks for local help.
If non-nil, this is the value returned by the call of
`run-with-idle-timer' that set that timer. This variable is used
internally to enable `help-at-pt-display-when-idle'. Do not set it
yourself.")
(defcustom help-at-pt-timer-delay 1
"*Delay before displaying local help.
This is used if `help-at-pt-display-when-idle' is enabled.
@ -112,17 +119,12 @@ active, but if one is already active, Custom will make it use the
new value."
:group 'help-at-pt
:type 'number
:initialize 'custom-initialize-default
:set (lambda (variable value)
(set-default variable value)
(when (and (boundp 'help-at-pt-timer) help-at-pt-timer)
(timer-set-idle-time help-at-pt-timer value t))))
(defvar help-at-pt-timer nil
"Non-nil means that a timer is set that checks for local help.
If non-nil, this is the value returned by the call of
`run-with-idle-timer' that set that timer. This variable is used
internally to enable `help-at-pt-display-when-idle'. Do not set it
yourself.")
(and (boundp 'help-at-pt-timer)
help-at-pt-timer
(timer-set-idle-time help-at-pt-timer value t))))
;;;###autoload
(defun help-at-pt-cancel-timer ()
@ -144,7 +146,6 @@ This is done by setting a timer, if none is currently active."
(run-with-idle-timer
help-at-pt-timer-delay t #'help-at-pt-maybe-display))))
;;;###autoload
(defcustom help-at-pt-display-when-idle 'never
"*Automatically show local help on point-over.
If the value is t, the string obtained from any `kbd-help' or

2
lisp/help-fns.el
View file

@ -473,7 +473,7 @@ Return 0 if there is no such symbol."
(and (symbolp obj) (boundp obj) obj))))
(error nil))
(let* ((str (find-tag-default))
(obj (if str (read str))))
(obj (if str (intern str))))
(and (symbolp obj) (boundp obj) obj))
0))

2
lisp/help.el
View file

@ -267,7 +267,7 @@ If that doesn't give a function, return nil."
(and (symbolp obj) (fboundp obj) obj))))
(error nil))))
(let* ((str (find-tag-default))
(obj (if str (read str))))
(obj (if str (intern str))))
(and (symbolp obj) (fboundp obj) obj))))

1
lisp/ibuffer.el
View file

@ -45,6 +45,7 @@
Ibuffer allows you to operate on buffers in a manner much like Dired.
Operations include sorting, marking by regular expression, and
the ability to filter the displayed buffers by various criteria."
:version "21.4"
:group 'convenience)
(defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide)

2
lisp/ido.el
View file

@ -338,6 +338,7 @@
"Switch between files using substrings."
:group 'extensions
:group 'convenience
:version "21.4"
:link '(emacs-commentary-link :tag "Commentary" "ido.el")
:link '(emacs-library-link :tag "Lisp File" "ido.el"))
@ -359,7 +360,6 @@ use either \\[customize] or the function `ido-mode'."
:require 'ido
:link '(emacs-commentary-link "ido.el")
:set-after '(ido-save-directory-list-file)
:version "21.4"
:type '(choice (const :tag "Turn on only buffer" buffer)
(const :tag "Turn on only file" file)
(const :tag "Turn on both buffer and file" both)

4
lisp/imenu.el
View file

@ -126,7 +126,9 @@ If `on-mouse' use a popup menu when `imenu' was invoked with the mouse."
(defcustom imenu-eager-completion-buffer
(not (eq imenu-always-use-completion-buffer-p 'never))
"If non-nil, eagerly popup the completion buffer."
:type 'boolean)
:type 'boolean
:group 'imenu
:version "21.4")
(defcustom imenu-after-jump-hook nil
"*Hooks called after jumping to a place in the buffer.

26
lisp/info.el
View file

@ -1476,11 +1476,21 @@ If DIRECTION is `backward', search in the reverse direction."
(save-excursion
(save-restriction
(widen)
(when backward
;; Hide Info file header for backward search
(narrow-to-region (save-excursion
(goto-char (point-min))
(search-forward "\n\^_")
(1- (point)))
(point-max)))
(while (and (not give-up)
(or (null found)
(if backward
(isearch-range-invisible found beg-found)
(isearch-range-invisible beg-found found))))
(isearch-range-invisible beg-found found))
;; Skip node header line
(save-excursion (forward-line -1)
(looking-at "\^_"))))
(if (if backward
(re-search-backward regexp bound t)
(re-search-forward regexp bound t))
@ -1531,14 +1541,24 @@ If DIRECTION is `backward', search in the reverse direction."
(while list
(message "Searching subfile %s..." (cdr (car list)))
(Info-read-subfile (car (car list)))
(if backward (goto-char (point-max)))
(when backward
;; Hide Info file header for backward search
(narrow-to-region (save-excursion
(goto-char (point-min))
(search-forward "\n\^_")
(1- (point)))
(point-max))
(goto-char (point-max)))
(setq list (cdr list))
(setq give-up nil found nil)
(while (and (not give-up)
(or (null found)
(if backward
(isearch-range-invisible found beg-found)
(isearch-range-invisible beg-found found))))
(isearch-range-invisible beg-found found))
;; Skip node header line
(save-excursion (forward-line -1)
(looking-at "\^_"))))
(if (if backward
(re-search-backward regexp nil t)
(re-search-forward regexp nil t))

20
lisp/international/mule-cmds.el
View file

@ -1368,12 +1368,14 @@ If INPUT-METHOD is nil, deactivate any current input method."
current-input-method-title nil)
(force-mode-line-update)))))
(defun set-input-method (input-method)
(defun set-input-method (input-method &optional interactive)
"Select and activate input method INPUT-METHOD for the current buffer.
This also sets the default input method to the one you specify.
If INPUT-METHOD is nil, this function turns off the input method, and
also causes you to be prompted for a name of an input method the next
time you invoke \\[toggle-input-method].
When called interactively, the optional arg INTERACTIVE is non-nil,
which marks the variable `default-input-method' as set for Custom buffers.
To deactivate the input method interactively, use \\[toggle-input-method].
To deactivate it programmatically, use \\[inactivate-input-method]."
@ -1381,14 +1383,15 @@ To deactivate it programmatically, use \\[inactivate-input-method]."
(let* ((default (or (car input-method-history) default-input-method)))
(list (read-input-method-name
(if default "Select input method (default %s): " "Select input method: ")
default t))))
default t)
t)))
(activate-input-method input-method)
(setq default-input-method input-method)
(when (interactive-p)
(when interactive
(customize-mark-as-set 'default-input-method))
default-input-method)
(defun toggle-input-method (&optional arg)
(defun toggle-input-method (&optional arg interactive)
"Enable or disable multilingual text input method for the current buffer.
Only one input method can be enabled at any time in a given buffer.
@ -1401,9 +1404,12 @@ minibuffer.
With a prefix argument, read an input method name with the minibuffer
and enable that one. The default is the most recent input method specified
\(not including the currently active input method, if any)."
\(not including the currently active input method, if any).
(interactive "P")
When called interactively, the optional arg INTERACTIVE is non-nil,
which marks the variable `default-input-method' as set for Custom buffers."
(interactive "P\np")
(if (and current-input-method (not arg))
(inactivate-input-method)
(let ((default (or (car input-method-history) default-input-method)))
@ -1420,7 +1426,7 @@ and enable that one. The default is the most recent input method specified
(unless default-input-method
(prog1
(setq default-input-method current-input-method)
(when (interactive-p)
(when interactive
(customize-mark-as-set 'default-input-method)))))))
(defun describe-input-method (input-method)

15
lisp/kmacro.el
View file

@ -1,6 +1,6 @@
;;; kmacro.el --- enhanced keyboard macros
;; Copyright (C) 2002 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard convenience
@ -120,6 +120,7 @@
"Simplified keyboard macro user interface."
:group 'keyboard
:group 'convenience
:version "21.4"
:link '(emacs-commentary-link :tag "Commentary" "kmacro.el")
:link '(emacs-library-link :tag "Lisp File" "kmacro.el"))
@ -222,6 +223,14 @@ macro to be executed before appending to it."
(global-set-key (vector kmacro-call-mouse-event) 'kmacro-end-call-mouse))
;;; Called from keyboard-quit
(defun kmacro-keyboard-quit ()
(or (not defining-kbd-macro)
(eq defining-kbd-macro 'append)
(kmacro-ring-empty-p)
(kmacro-pop-ring)))
;;; Keyboard macro counter
@ -585,7 +594,9 @@ Use \\[kmacro-bind-to-key] to bind it to a key sequence."
(and append
(if kmacro-execute-before-append
(> (car arg) 4)
(= (car arg) 4)))))))
(= (car arg) 4))))
(if (and defining-kbd-macro append)
(setq defining-kbd-macro 'append)))))
;;;###autoload

24
lisp/mail/supercite.el
View file

@ -1424,18 +1424,21 @@ Optional CITATION overrides any citation automatically selected."
nil)
;; interactive functions
(defun sc-cite-region (start end &optional confirm-p)
(defun sc-cite-region (start end &optional confirm-p interactive)
"Cite a region delineated by START and END.
If optional CONFIRM-P is non-nil, the attribution is confirmed before
its use in the citation string. This function first runs
`sc-pre-cite-hook'."
(interactive "r\nP")
`sc-pre-cite-hook'.
When called interactively, the optional arg INTERACTIVE is non-nil,
and that means call `sc-select-attribution' too."
(interactive "r\nP\np")
(undo-boundary)
(let ((frame (or (sc-scan-info-alist sc-cite-frame-alist)
sc-default-cite-frame))
(sc-confirm-always-p (if confirm-p t sc-confirm-always-p)))
(run-hooks 'sc-pre-cite-hook)
(if (interactive-p)
(if interactive
(sc-select-attribution))
(regi-interpret frame start end)))
@ -1978,16 +1981,15 @@ cited."
(insert (sc-mail-field "sc-citation"))
(error "Line is already cited"))))
(defun sc-version (arg)
(defun sc-version (message)
"Echo the current version of Supercite in the minibuffer.
With \\[universal-argument] (universal-argument), or if run non-interactively,
If MESSAGE is non-nil (interactively, with no prefix argument),
inserts the version string in the current buffer instead."
(interactive "P")
(interactive (not current-prefix-arg))
(let ((verstr (format "Using Supercite.el %s" sc-version)))
(if (or (consp arg)
(not (interactive-p)))
(insert "`sc-version' says: " verstr)
(message verstr))))
(if message
(message verstr)
(insert "`sc-version' says: " verstr))))
(defun sc-describe ()
"

4
lisp/makefile.w32-in
View file

@ -170,7 +170,7 @@ cus-load.el:
touch $@
custom-deps: cus-load.el doit
@echo Directories: $(WINS)
-$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hooks nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS)
-$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hook nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS)
finder-data: doit
@echo Directories: $(WINS)
@ -220,7 +220,7 @@ loaddefs.el-CMD:
autoloads: loaddefs.el doit
@echo Directories: $(WINS)
$(emacs) -l autoload \
--eval $(ARGQUOTE)(setq find-file-hooks nil \
--eval $(ARGQUOTE)(setq find-file-hook nil \
find-file-suppress-same-file-warnings t \
generated-autoload-file \
$(DQUOTE)$(lisp)/loaddefs.el$(DQUOTE))$(ARGQUOTE) \

2
lisp/man.el
View file

@ -426,7 +426,7 @@ Otherwise, the value is whatever the function
(view-file f)
(error "Cannot read a file: %s" f))
(error "Cannot find a file: %s" f))))
'help-echo "mouse-2: mouse-2: display this file")
'help-echo "mouse-2: display this file")
;; ======================================================================

9
lisp/menu-bar.el
View file

@ -186,10 +186,15 @@ A large number or nil slows down menu responsiveness."
'(menu-item "Open Directory..." dired
:help "Read a directory, operate on its files"))
(define-key menu-bar-files-menu [open-file]
'(menu-item "Open File..." find-file
'(menu-item "Open File..." find-file-existing
:enable (not (window-minibuffer-p
(frame-selected-window menu-updating-frame)))
:help "Read a file into an Emacs buffer"))
:help "Read an existing file into an Emacs buffer"))
(define-key menu-bar-files-menu [new-file]
'(menu-item "New File..." find-file
:enable (not (window-minibuffer-p
(frame-selected-window menu-updating-frame)))
:help "Read or create a file and edit it"))
;; The "Edit" menu items

7
lisp/mouse.el
View file

@ -1068,8 +1068,7 @@ If MODE is 2 then do the same for lines."
(unless ignore
;; For certain special keys, delete the region.
(if (member key mouse-region-delete-keys)
(delete-region (overlay-start mouse-drag-overlay)
(overlay-end mouse-drag-overlay))
(delete-region (mark t) (point))
;; Otherwise, unread the key so it gets executed normally.
(setq unread-command-events
(nconc events unread-command-events))))
@ -1112,7 +1111,7 @@ and set mark at the beginning.
Prefix arguments are interpreted as with \\[yank].
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
(interactive "*e\nP")
(interactive "e\nP")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))
@ -1414,7 +1413,7 @@ The function returns a non-nil value if it creates a secondary selection."
Move point to the end of the inserted text.
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
(interactive "*e")
(interactive "e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))

7
lisp/net/browse-url.el
View file

@ -596,10 +596,11 @@ for use in `interactive'."
(not (eq (null browse-url-new-window-flag)
(null current-prefix-arg)))))
;; interactive-p needs to be called at a function's top-level, hence
;; the macro.
;; called-interactive-p needs to be called at a function's top-level, hence
;; this macro. We use that rather than interactive-p because
;; use in a keyboard macro should not change this behavior.
(defmacro browse-url-maybe-new-window (arg)
`(if (not (interactive-p))
`(if (or noninteractive (not (called-interactively-p)))
,arg
browse-url-new-window-flag))

142
lisp/net/eudc.el
View file

@ -462,73 +462,73 @@ attribute name ATTR."
"Display the record list RECORDS in a formatted buffer.
If RAW-ATTR-NAMES is non-nil, the raw attribute names are displayed
otherwise they are formatted according to `eudc-user-attribute-names-alist'."
(let ((buffer (get-buffer-create "*Directory Query Results*"))
inhibit-read-only
(let (inhibit-read-only
precords
(width 0)
beg
first-record
attribute-name)
(switch-to-buffer buffer)
(setq buffer-read-only t)
(setq inhibit-read-only t)
(erase-buffer)
(insert "Directory Query Result\n")
(insert "======================\n\n\n")
(if (null records)
(insert "No match found.\n"
(if eudc-strict-return-matches
"Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n"
""))
;; Replace field names with user names, compute max width
(setq precords
(mapcar
(function
(lambda (record)
(with-output-to-temp-buffer "*Directory Query Results*"
(with-current-buffer standard-output
(setq buffer-read-only t)
(setq inhibit-read-only t)
(erase-buffer)
(insert "Directory Query Result\n")
(insert "======================\n\n\n")
(if (null records)
(insert "No match found.\n"
(if eudc-strict-return-matches
"Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n"
""))
;; Replace field names with user names, compute max width
(setq precords
(mapcar
(function
(lambda (field)
(setq attribute-name
(if raw-attr-names
(symbol-name (car field))
(eudc-format-attribute-name-for-display (car field))))
(if (> (length attribute-name) width)
(setq width (length attribute-name)))
(cons attribute-name (cdr field))))
record)))
records))
;; Display the records
(setq first-record (point))
(mapcar
(function
(lambda (record)
(setq beg (point))
;; Map over the record fields to print the attribute/value pairs
(mapcar (function
(lambda (field)
(eudc-print-record-field field width)))
record)
;; Store the record internal format in some convenient place
(overlay-put (make-overlay beg (point))
'eudc-record
(car records))
(setq records (cdr records))
(insert "\n")))
precords))
(insert "\n")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(eudc-query-form))
"New query")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(kill-this-buffer))
"Quit")
(eudc-mode)
(widget-setup)
(if first-record
(goto-char first-record))))
(lambda (record)
(mapcar
(function
(lambda (field)
(setq attribute-name
(if raw-attr-names
(symbol-name (car field))
(eudc-format-attribute-name-for-display (car field))))
(if (> (length attribute-name) width)
(setq width (length attribute-name)))
(cons attribute-name (cdr field))))
record)))
records))
;; Display the records
(setq first-record (point))
(mapcar
(function
(lambda (record)
(setq beg (point))
;; Map over the record fields to print the attribute/value pairs
(mapcar (function
(lambda (field)
(eudc-print-record-field field width)))
record)
;; Store the record internal format in some convenient place
(overlay-put (make-overlay beg (point))
'eudc-record
(car records))
(setq records (cdr records))
(insert "\n")))
precords))
(insert "\n")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(eudc-query-form))
"New query")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(kill-this-buffer))
"Quit")
(eudc-mode)
(widget-setup)
(if first-record
(goto-char first-record))))))
(defun eudc-process-form ()
"Process the query form in current buffer and display the results."
@ -709,34 +709,36 @@ server for future sessions."
(eudc-save-options)))
;;;###autoload
(defun eudc-get-email (name)
"Get the email field of NAME from the directory server."
(interactive "sName: ")
(defun eudc-get-email (name &optional error)
"Get the email field of NAME from the directory server.
If ERROR is non-nil, report an error if there is none."
(interactive "sName: \np")
(or eudc-server
(call-interactively 'eudc-set-server))
(let ((result (eudc-query (list (cons 'name name)) '(email)))
email)
(if (null (cdr result))
(setq email (eudc-cdaar result))
(error "Multiple match. Use the query form"))
(if (interactive-p)
(error "Multiple match--use the query form"))
(if error
(if email
(message "%s" email)
(error "No record matching %s" name)))
email))
;;;###autoload
(defun eudc-get-phone (name)
"Get the phone field of NAME from the directory server."
(interactive "sName: ")
(defun eudc-get-phone (name &optional error)
"Get the phone field of NAME from the directory server.
If ERROR is non-nil, report an error if there is none."
(interactive "sName: \np")
(or eudc-server
(call-interactively 'eudc-set-server))
(let ((result (eudc-query (list (cons 'name name)) '(phone)))
phone)
(if (null (cdr result))
(setq phone (eudc-cdaar result))
(error "Multiple match. Use the query form"))
(if (interactive-p)
(error "Multiple match--use the query form"))
(if error
(if phone
(message "%s" phone)
(error "No record matching %s" name)))

3
lisp/net/tls.el
View file

@ -67,18 +67,21 @@ after successful negotiation."
(defcustom tls-process-connection-type nil
"*Value for `process-connection-type' to use when starting TLS process."
:version "21.4"
:type 'boolean
:group 'tls)
(defcustom tls-success "- Handshake was completed"
"*Regular expression indicating completed TLS handshakes.
The default is what GNUTLS's \"gnutls-cli\" outputs."
:version "21.4"
:type 'regexp
:group 'tls)
(defcustom tls-certtool-program (executable-find "certtool")
"Name of GnuTLS certtool.
Used by `tls-certificate-information'."
:version "21.4"
:type '(repeat string)
:group 'tls)

5
lisp/play/5x5.el
View file

@ -224,9 +224,8 @@ Quit current game \\[5x5-quit-game]"
5x5-y-pos (/ 5x5-grid-size 2)
5x5-moves 0
5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos))
(when (interactive-p)
(5x5-draw-grid (list 5x5-grid))
(5x5-position-cursor))))
(5x5-draw-grid (list 5x5-grid))
(5x5-position-cursor)))
(defun 5x5-quit-game ()
"Quit the current game of `5x5'."

4
lisp/play/fortune.el
View file

@ -271,7 +271,7 @@ and choose the directory as the fortune-file."
(fortune-ask-file)
fortune-file)))
(save-excursion
(fortune-in-buffer (interactive-p) file)
(fortune-in-buffer t file)
(set-buffer fortune-buffer-name)
(let* ((fortune (buffer-string))
(signature (concat fortune-sigstart fortune fortune-sigend)))
@ -285,7 +285,7 @@ and choose the directory as the fortune-file."
(defun fortune-in-buffer (interactive &optional file)
"Put a fortune cookie in the *fortune* buffer.
When INTERACTIVE is nil, don't display it. Optional argument FILE,
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)))

6
lisp/progmodes/ada-xref.el
View file

@ -2154,17 +2154,17 @@ This is a GNAT specific function that uses gnatkrunch."
adaname
)
(defun ada-make-body-gnatstub ()
(defun ada-make-body-gnatstub (&optional interactive)
"Create an Ada package body in the current buffer.
This function uses the `gnatstub' program to create the body.
This function typically is to be hooked into `ff-file-created-hooks'."
(interactive)
(interactive "p")
(save-some-buffers nil nil)
;; If the current buffer is the body (as is the case when calling this
;; function from ff-file-created-hooks), then kill this temporary buffer
(unless (interactive-p)
(unless interactive
(progn
(set-buffer-modified-p nil)
(kill-buffer (current-buffer))))

6
lisp/progmodes/cperl-mode.el
View file

@ -6664,11 +6664,11 @@ prototype \&SUB Returns prototype of the function given a reference.
=pod Switch from Perl to POD.
")
(defun cperl-switch-to-doc-buffer ()
(defun cperl-switch-to-doc-buffer (&optional interactive)
"Go to the perl documentation buffer and insert the documentation."
(interactive)
(interactive "p")
(let ((buf (get-buffer-create cperl-doc-buffer)))
(if (interactive-p)
(if interactive
(switch-to-buffer-other-window buf)
(set-buffer buf))
(if (= (buffer-size) 0)

8
lisp/progmodes/f90.el
View file

@ -1223,14 +1223,16 @@ Return (TYPE NAME), or nil if not found."
With optional argument NUM, go forward that many balanced blocks.
If NUM is negative, go backward to the start of a block.
Checks for consistency of block types and labels (if present),
and completes outermost block if necessary."
and completes outermost block if necessary.
Some of these things (which?) are not done if NUM is nil,
which only happens in a noninteractive call."
(interactive "p")
(if (and num (< num 0)) (f90-beginning-of-block (- num)))
(let ((f90-smart-end nil) ; for the final `f90-match-end'
(case-fold-search t)
(count (or num 1))
start-list start-this start-type start-label end-type end-label)
(if (interactive-p) (push-mark (point) t))
(if num (push-mark (point) t))
(end-of-line) ; probably want this
(while (and (> count 0) (re-search-forward f90-blocks-re nil 'move))
(beginning-of-line)
@ -1266,7 +1268,7 @@ and completes outermost block if necessary."
(end-of-line))
(if (> count 0) (error "Missing block end"))
;; Check outermost block.
(if (interactive-p)
(if num
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t0-9")

49
lisp/progmodes/flymake.el
View file

@ -56,7 +56,7 @@
(defun flymake-makehash(&optional test)
(cond
((equal flymake-emacs 'xemacs) (if test (make-hash-table :test test) (make-hash-table)))
(t (makehash test))
(t (makehash test))
)
)
@ -370,8 +370,8 @@
(let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name))))
;(flymake-log 0 "calling %s" init-f)
;(funcall init-f (current-buffer))
init-f
)
(nth 0 (flymake-get-file-name-mode-and-masks file-name))
)
(defun flymake-get-cleanup-function(file-name)
@ -846,7 +846,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
(set-buffer source-buffer)
(flymake-parse-residual source-buffer)
(flymake-post-syntax-check source-buffer)
(flymake-post-syntax-check source-buffer exit-status command)
(flymake-set-buffer-is-running source-buffer nil)
)
)
@ -863,7 +863,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
)
)
(defun flymake-post-syntax-check(source-buffer)
(defun flymake-post-syntax-check(source-buffer exit-status command)
""
(flymake-set-buffer-err-info source-buffer (flymake-get-buffer-new-err-info source-buffer))
(flymake-set-buffer-new-err-info source-buffer nil)
@ -1220,7 +1220,33 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
)
)
(eval-when-compile (require 'compile))
(defun flymake-reformat-err-line-patterns-from-compile-el(original-list)
"grab error line patterns from original list in compile.el format, convert to flymake internal format"
(let* ((converted-list '()))
(mapcar
(lambda (item)
(setq item (cdr item))
(let ((regexp (nth 0 item))
(file (nth 1 item))
(line (nth 2 item))
(col (nth 3 item))
end-line)
(if (consp file) (setq file (car file)))
(if (consp line) (setq end-line (cdr line) line (car line)))
(if (consp col) (setq col (car col)))
(when (not (functionp line))
(setq converted-list (cons (list regexp file line col) converted-list))
)
)
)
original-list
)
converted-list
)
)
(require 'compile)
(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text
(append
'(
@ -1243,9 +1269,9 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
(" *\\(\\[javac\\]\\)? *\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[ \t\n]*\\(.+\\)"
2 4 nil 5)
)
;; compilation-error-regexp-alist)
(mapcar (lambda (x) (cdr x)) compilation-error-regexp-alist-alist))
"patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx)"
;; compilation-error-regexp-alist)
(flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist))
"patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx). Use flymake-reformat-err-line-patterns-from-compile-el to add patterns from compile.el"
)
;(defcustom flymake-err-line-patterns
; '(
@ -1452,7 +1478,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
(let* ((dir (nth idx include-dirs)))
(setq full-file-name (concat dir "/" rel-file-name))
(when (file-exists-p full-file-name)
(setq done t)
(setq found t)
)
)
(setq idx (1+ idx))
@ -1574,7 +1600,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
process
)
(error
(let ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s"
(let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s"
cmd args (error-message-string err)))
(source-file-name (buffer-file-name buffer))
(cleanup-f (flymake-get-cleanup-function source-file-name)))
@ -1905,7 +1931,8 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
(defun flymake-mode(&optional arg)
"toggle flymake-mode"
(interactive)
(let ((old-flymake-mode flymake-mode))
(let ((old-flymake-mode flymake-mode)
(turn-on nil))
(setq turn-on
(if (null arg)

18
lisp/progmodes/gdb-ui.el
View file

@ -133,12 +133,14 @@ detailed description of this mode.
(defcustom gdb-enable-debug-log nil
"Non-nil means record the process input and output in `gdb-debug-log'."
:type 'boolean
:group 'gud)
:group 'gud
:version "21.4")
(defcustom gdb-use-inferior-io-buffer nil
"Non-nil means display output from the inferior in a separate buffer."
:type 'boolean
:group 'gud)
:group 'gud
:version "21.4")
(defun gdb-ann3 ()
(setq gdb-debug-log nil)
@ -211,7 +213,8 @@ detailed description of this mode.
(defcustom gdb-use-colon-colon-notation nil
"If non-nil use FUN::VAR format to display variables in the speedbar." ;
:type 'boolean
:group 'gud)
:group 'gud
:version "21.4")
(defun gud-watch ()
"Watch expression at point."
@ -658,7 +661,8 @@ This filter may simply queue input for a later time."
(defcustom gud-gdba-command-name "gdb -annotate=3"
"Default command to execute an executable under the GDB-UI debugger."
:type 'string
:group 'gud)
:group 'gud
:version "21.4")
(defvar gdb-annotation-rules
'(("pre-prompt" gdb-pre-prompt)
@ -1685,7 +1689,8 @@ static char *magick[] = {
(defcustom gdb-show-main nil
"Nil means don't display source file containing the main routine."
:type 'boolean
:group 'gud)
:group 'gud
:version "21.4")
(defun gdb-setup-windows ()
"Layout the window pattern for gdb-many-windows."
@ -1726,7 +1731,8 @@ buffer and the other with the source file with the main routine
of the inferior. Non-nil means display the layout shown for
`gdba'."
:type 'boolean
:group 'gud)
:group 'gud
:version "21.4")
(defun gdb-many-windows (arg)
"Toggle the number of windows in the basic arrangement."

10
lisp/progmodes/grep.el
View file

@ -436,9 +436,11 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
(defun grep-default-command ()
(let ((tag-default
(funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
'find-tag-default)))
(shell-quote-argument
(or (funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
'find-tag-default))
"")))
(sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
(grep-default (or (car grep-history) grep-command)))
;; Replace the thing matching for with that around cursor.
@ -460,7 +462,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
0 (match-beginning 2))
" *."
(file-name-extension buffer-file-name))))
(replace-match (or tag-default "") t t grep-default 1))))
(replace-match tag-default t t grep-default 1))))
;;;###autoload
(defun grep (command-args &optional highlight-regexp)

6
lisp/progmodes/idlw-shell.el
View file

@ -1137,10 +1137,10 @@ prompt is present and if `idlwave-shell-ready' is non-nil."
(goto-char save-point))
(set-buffer save-buffer))))
(defun idlwave-shell-send-char (c &optional no-error)
(defun idlwave-shell-send-char (c &optional error)
"Send one character to the shell, without a newline."
(interactive "cChar to send to IDL: ")
(let ((errf (if (interactive-p) 'error 'message))
(interactive "cChar to send to IDL: \np")
(let ((errf (if error 'error 'message))
buf proc)
(if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
(not (setq proc (get-buffer-process buf))))

8
lisp/progmodes/idlwave.el
View file

@ -4231,7 +4231,7 @@ will re-read the catalog."
(defvar idlwave-load-rinfo-idle-timer)
(defun idlwave-update-routine-info (&optional arg)
(defun idlwave-update-routine-info (&optional arg dont-concentrate)
"Update the internal routine-info lists.
These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info])
and by `idlwave-complete' (\\[idlwave-complete]) to provide information
@ -4248,10 +4248,12 @@ Scans all IDLWAVE-mode buffers of the current editing session (see
When an IDL shell is running, this command also queries the IDL program
for currently compiled routines.
???Document what DONT-CONCENTRATE means???
With prefix ARG, also reload the system and library lists.
With two prefix ARG's, also rescans the library tree.
With three prefix args, dispatch asynchronous process to do the update."
(interactive "P")
(interactive "P\np")
;; Stop any idle processing
(if (or (and (fboundp 'itimerp)
(itimerp idlwave-load-rinfo-idle-timer))
@ -4300,7 +4302,7 @@ With three prefix args, dispatch asynchronous process to do the update."
idlwave-query-shell-for-routine-info)))
(if (or (not ask-shell)
(not (interactive-p)))
(not dont-concentrate))
;; 1. If we are not going to ask the shell, we need to do the
;; concatenation now.
;; 2. When this function is called non-interactively, it means

14
lisp/progmodes/vhdl-mode.el
View file

@ -6120,17 +6120,17 @@ stops due to beginning or end of buffer."
(vhdl-keep-region-active)
foundp))
(defun vhdl-beginning-of-statement (&optional count lim)
(defun vhdl-beginning-of-statement (&optional count lim interactive)
"Go to the beginning of the innermost VHDL statement.
With prefix arg, go back N - 1 statements. If already at the
beginning of a statement then go to the beginning of the preceding
one. If within a string or comment, or next to a comment (only
whitespace between), move by sentences instead of statements.
When called from a program, this function takes 2 optional args: the
When called from a program, this function takes 3 optional args: the
prefix arg, and a buffer position limit which is the farthest back to
search."
(interactive "p")
search, and something whose meaning I don't understand."
(interactive "p\np")
(let ((count (or count 1))
(case-fold-search t)
(lim (or lim (point-min)))
@ -6139,7 +6139,7 @@ search."
(save-excursion
(goto-char lim)
(setq state (parse-partial-sexp (point) here nil nil)))
(if (and (interactive-p)
(if (and interactive
(or (nth 3 state)
(nth 4 state)
(looking-at (concat "[ \t]*" comment-start-skip))))
@ -7531,10 +7531,10 @@ buffer."
(defun vhdl-fill-region (beg end &optional arg)
"Fill lines for a region of code."
(interactive "r")
(interactive "r\np")
(save-excursion
(goto-char beg)
(let ((margin (if (interactive-p) (current-indentation) (current-column))))
(let ((margin (if interactive (current-indentation) (current-column))))
(goto-char end)
(setq end (point-marker))
;; remove inline comments, newlines and whitespace

79
lisp/reveal.el
View file

@ -1,6 +1,6 @@
;;; reveal.el --- Automatically reveal hidden text at point
;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: outlines
@ -59,6 +59,9 @@
(defvar reveal-open-spots nil)
(make-variable-buffer-local 'reveal-open-spots)
(defvar reveal-last-tick nil)
(make-variable-buffer-local 'reveal-last-tick)
;; Actual code
(defun reveal-post-command ()
@ -90,16 +93,16 @@
(overlays-at (point))))
(push (cons (selected-window) ol) reveal-open-spots)
(setq old-ols (delq ol old-ols))
(let ((open (overlay-get ol 'reveal-toggle-invisible)))
(let ((open (overlay-get ol 'reveal-toggle-invisible)) inv)
(when (or open
(let ((inv (overlay-get ol 'invisible)))
(and inv (symbolp inv)
(or (setq open (or (get inv 'reveal-toggle-invisible)
(overlay-get ol 'isearch-open-invisible-temporary)))
(overlay-get ol 'isearch-open-invisible)
(and (consp buffer-invisibility-spec)
(assq inv buffer-invisibility-spec)))
(overlay-put ol 'reveal-invisible inv))))
(and (setq inv (overlay-get ol 'invisible))
(symbolp inv)
(or (setq open (or (get inv 'reveal-toggle-invisible)
(overlay-get ol 'isearch-open-invisible-temporary)))
(overlay-get ol 'isearch-open-invisible)
(and (consp buffer-invisibility-spec)
(assq inv buffer-invisibility-spec)))
(overlay-put ol 'reveal-invisible inv)))
(if (null open)
(overlay-put ol 'invisible nil)
;; Use the provided opening function and repeat (since the
@ -113,27 +116,39 @@
(setq repeat nil)
(overlay-put ol 'invisible nil))))))))
;; Close old overlays.
(dolist (ol old-ols)
(when (and (eq (current-buffer) (overlay-buffer ol))
(not (rassq ol reveal-open-spots)))
(if (and (>= (point) (save-excursion
(goto-char (overlay-start ol))
(line-beginning-position 1)))
(<= (point) (save-excursion
(goto-char (overlay-end ol))
(line-beginning-position 2))))
;; Still near the overlay: keep it open.
(push (cons (selected-window) ol) reveal-open-spots)
;; Really close it.
(let ((open (overlay-get ol 'reveal-toggle-invisible)) inv)
(if (or open
(and (setq inv (overlay-get ol 'reveal-invisible))
(setq open (or (get inv 'reveal-toggle-invisible)
(overlay-get ol 'isearch-open-invisible-temporary)))))
(condition-case err
(funcall open ol t)
(error (message "!!Reveal-hide: %s !!" err)))
(overlay-put ol 'invisible inv)))))))
(if (not (eq reveal-last-tick
(setq reveal-last-tick (buffer-modified-tick))))
;; The buffer was modified since last command: let's refrain from
;; closing any overlay because it tends to behave poorly when
;; inserting text at the end of an overlay (basically the overlay
;; should be rear-advance when it's open, but things like
;; outline-minor-mode make it non-rear-advance because it's
;; a better choice when it's closed).
(dolist (ol old-ols)
(push (cons (selected-window) ol) reveal-open-spots))
;; The last command was only a point motion or some such
;; non-buffer-modifying command. Let's close whatever can be closed.
(dolist (ol old-ols)
(when (and (eq (current-buffer) (overlay-buffer ol))
(not (rassq ol reveal-open-spots)))
(if (and (>= (point) (save-excursion
(goto-char (overlay-start ol))
(line-beginning-position 1)))
(<= (point) (save-excursion
(goto-char (overlay-end ol))
(line-beginning-position 2))))
;; Still near the overlay: keep it open.
(push (cons (selected-window) ol) reveal-open-spots)
;; Really close it.
(let ((open (overlay-get ol 'reveal-toggle-invisible)) inv)
(if (or open
(and (setq inv (overlay-get ol 'reveal-invisible))
(setq open (or (get inv 'reveal-toggle-invisible)
(overlay-get ol 'isearch-open-invisible-temporary)))))
(condition-case err
(funcall open ol t)
(error (message "!!Reveal-hide: %s !!" err)))
(overlay-put ol 'invisible inv))))))))
(error (message "Reveal: %s" err)))))
;;;###autoload
@ -171,5 +186,5 @@ With zero or negative ARG turn mode off."
(provide 'reveal)
;;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8
;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8
;;; reveal.el ends here

4
lisp/simple.el
View file

@ -1,7 +1,7 @@
;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
;; 2000, 01, 02, 03, 04
;; 2000, 01, 02, 03, 2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@ -3920,6 +3920,8 @@ During execution of Lisp code, this character causes a quit directly.
At top-level, as an editor command, this simply beeps."
(interactive)
(deactivate-mark)
(if (fboundp 'kmacro-keyboard-quit)
(kmacro-keyboard-quit))
(setq defining-kbd-macro nil)
(signal 'quit nil))

1187
lisp/textmodes/bibtex.el
View file

File diff suppressed because it is too large Load diff

4
lisp/textmodes/flyspell.el
View file

@ -956,9 +956,7 @@ Mostly we check word delimiters."
;*---------------------------------------------------------------------*/
(defun flyspell-word (&optional following)
"Spell check a word."
(interactive (list current-prefix-arg))
(if (interactive-p)
(setq following ispell-following-word))
(interactive (list ispell-following-word))
(save-excursion
;; use the correct dictionary
(flyspell-accept-buffer-local-defs)

5
lisp/textmodes/ispell.el
View file

@ -1410,12 +1410,9 @@ nil word is correct or spelling is accepted.
\(\"word\" arg\) word is hand entered.
quit spell session exited."
(interactive (list nil nil current-prefix-arg))
(interactive (list ispell-following-word ispell-quietly current-prefix-arg))
(if continue
(ispell-continue)
(if (interactive-p)
(setq following ispell-following-word
quietly ispell-quietly))
(ispell-accept-buffer-local-defs) ; use the correct dictionary
(let ((cursor-location (point)) ; retain cursor location
(word (ispell-get-word following))

3
lisp/textmodes/table.el
View file

@ -645,7 +645,8 @@ See `table-insert' for examples about how to use."
:group 'editing
:group 'wp
:group 'paragraphs
:group 'fill)
:group 'fill
:version "21.4")
(defgroup table-hooks nil
"Hooks for table manipulation utilities"

4
lisp/textmodes/texinfo.el
View file

@ -1,7 +1,7 @@
;;; texinfo.el --- major mode for editing Texinfo files
;; Copyright (C) 1985,88,89,90,91,92,93,96,97,2000,01,03,04
;; Free Software Foundation, Inc.
;; Copyright (C) 1985, 1988, 1989, 1990, 1991, 1992, 1993, 1996, 1997,
;; 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
;; Author: Robert J. Chassell
;; Date: [See date below for texinfo-version]

7
lisp/thumbs.el
View file

@ -30,8 +30,8 @@
;;; Commentary:
;; This package create two new mode: thumbs-mode and
;; thumbs-view-image-mode. It is used for images browsing and viewing
;; from within emacs. Minimal image manipulation functions are also
;; thumbs-view-image-mode. It is used for images browsing and viewing
;; from within Emacs. Minimal image manipulation functions are also
;; available via external programs.
;;
;; The 'convert' program from 'ImageMagick'
@ -62,6 +62,7 @@
(defgroup thumbs nil
"Thumbnails previewer."
:version "21.4"
:group 'multimedia)
(defcustom thumbs-thumbsdir
@ -416,7 +417,7 @@ and SAME-WINDOW to show thumbs in the same window."
(defalias 'thumbs 'thumbs-show-all-from-dir)
(defun thumbs-find-image (img &optional num otherwin)
(funcall
(funcall
(if otherwin 'switch-to-buffer-other-window 'switch-to-buffer)
(concat "*Image: " (file-name-nondirectory img) " - "
(number-to-string (or num 0)) "*"))

BIN
lisp/toolbar/diropen.pbm Normal file
View file

Binary file not shown.

215
lisp/toolbar/diropen.xpm Normal file
View file

@ -0,0 +1,215 @@
/* XPM */
static char * diropen_xpm[] = {
"24 24 188 2",
" c None",
". c #000000",
"+ c #010100",
"@ c #B5B8A5",
"# c #E4E7D2",
"$ c #878A76",
"% c #33342B",
"& c #0B0B0B",
"* c #E2E5CF",
"= c #CFD4AF",
"- c #CED3AE",
"; c #B2B696",
"> c #2D2D25",
", c #23241D",
"' c #9D9F90",
") c #C6CAA6",
"! c #C4C9A5",
"~ c #C6CBA7",
"{ c #C7CCA8",
"] c #C9CEA9",
"^ c #555847",
"/ c #1A1B15",
"( c #20201A",
"_ c #D4D6C2",
": c #BEC2A0",
"< c #B3B896",
"[ c #B0B595",
"} c #B3B797",
"| c #B6BB99",
"1 c #BBC09E",
"2 c #BCC19F",
"3 c #81856C",
"4 c #3E3F32",
"5 c #010101",
"6 c #DADDC8",
"7 c #AFB494",
"8 c #AAAF8F",
"9 c #A3A789",
"0 c #A6AA8B",
"a c #A9AD8E",
"b c #A7AB8D",
"c c #A4A88A",
"d c #A1A588",
"e c #AAAD96",
"f c #B3B5A5",
"g c #B8BBAA",
"h c #BABCAB",
"i c #40413B",
"j c #CACDBB",
"k c #BABDA8",
"l c #0C0C09",
"m c #DDDFCB",
"n c #969B7E",
"o c #9DA286",
"p c #95987C",
"q c #96997E",
"r c #9A9D81",
"s c #999D80",
"t c #9DA184",
"u c #A5AA8B",
"v c #A4A98A",
"w c #A3A889",
"x c #A2A588",
"y c #33352B",
"z c #9B9E83",
"A c #898D74",
"B c #D8DBC9",
"C c #84866E",
"D c #7D8169",
"E c #151612",
"F c #D7DAC9",
"G c #797D67",
"H c #3D3F34",
"I c #E0E0D9",
"J c #EBEDDD",
"K c #E8EBD9",
"L c #D8DBCA",
"M c #1A1A18",
"N c #0A0A09",
"O c #6E7067",
"P c #8D8F84",
"Q c #4A4B45",
"R c #2C2D29",
"S c #4B4C46",
"T c #E7EAD8",
"U c #E3E6D4",
"V c #DEE1D0",
"W c #DADCCC",
"X c #DADCD1",
"Y c #2B2C28",
"Z c #D7DAC6",
"` c #6F735E",
" . c #0D0D0D",
".. c #F4F4EC",
"+. c #606251",
"@. c #92957B",
"#. c #4A4C3E",
"$. c #434438",
"%. c #CACFAB",
"&. c #C6CBA8",
"*. c #C2C6A4",
"=. c #ABB091",
"-. c #23251E",
";. c #494B3D",
">. c #DCDCD4",
",. c #EAECDD",
"'. c #CDD2AD",
"). c #20201B",
"!. c #1C1C17",
"~. c #A4A88B",
"{. c #414337",
"]. c #BABF9D",
"^. c #B5B999",
"/. c #81836C",
"(. c #070806",
"_. c #D5D8C4",
":. c #161616",
"<. c #F2F2EA",
"[. c #CACFAA",
"}. c #050504",
"|. c #3C3D32",
"1. c #C9CEAA",
"2. c #C8CDA9",
"3. c #BFC4A2",
"4. c #3E4035",
"5. c #BCC09F",
"6. c #B6BB9A",
"7. c #B0B494",
"8. c #9DA185",
"9. c #535445",
"0. c #B6B8A7",
"a. c #747470",
"b. c #ECECE2",
"c. c #C3C8A5",
"d. c #C2C7A4",
"e. c #393B30",
"f. c #BFC4A1",
"g. c #BDC2A0",
"h. c #C0C5A2",
"i. c #3A3B31",
"j. c #A9AD8F",
"k. c #A3A78A",
"l. c #80836D",
"m. c #020201",
"n. c #A6A998",
"o. c #B8BC9B",
"p. c #1B1C17",
"q. c #181814",
"r. c #AFB394",
"s. c #ACB091",
"t. c #878A72",
"u. c #9B9F83",
"v. c #9A9D82",
"w. c #8A8D75",
"x. c #4F5243",
"y. c #070705",
"z. c #9E9F91",
"A. c #E5E6DA",
"B. c #ADB192",
"C. c #A6AA8C",
"D. c #A5A98C",
"E. c #4B4D3F",
"F. c #70735F",
"G. c #9FA286",
"H. c #999D81",
"I. c #35362D",
"J. c #2D2E26",
"K. c #8A8D74",
"L. c #71735F",
"M. c #080908",
"N. c #E3E5D9",
"O. c #C0C3AF",
"P. c #94987C",
"Q. c #8F9379",
"R. c #8B8F75",
"S. c #8A8E74",
"T. c #888C73",
"U. c #7D816A",
"V. c #0E0F0C",
"W. c #3E4034",
"X. c #4E5042",
"Y. c #282922",
"Z. c #121310",
"`. c #24251F",
" + c #71745F",
".+ c #6A6D59",
"++ c #434538",
"@+ c #080907",
" ",
" ",
" ",
" . . . . . . . ",
" + @ # # # # # $ % ",
" & * = = = - - ; > ",
", ' * ) ! ~ { ] ] ^ / . . ",
"( _ : < [ } | 1 2 3 4 5 . . . . . . . ",
", 6 7 8 9 0 8 a b c d e f g h . i j k . ",
"l m n o p q r s q t u v w x 9 . y z A . ",
". B C D E . . . . . . . . . . . . . . . 5 5 ",
". F G H I J K K L M N O P Q R . S T U V W X Y ",
". Z ` ...= = = +.. @.= = = #.. $.%.&.*.1 =.-. ",
". Z ;.>.,.'.- - ).!.'.'.'.'.~.. {.&.*.].^./.(. ",
". _.:.<.%.[.%.[.}.|.1.{ 2.2.3.. 4.5.6.7.8.9.l ",
". 0.a.b.c.d.d.*.}.e.f.g.h.g.} . i.[ j.k.l.m. ",
". n.>.o.o.^.} } p.q.r.r.r.s.t.. % u.v.w.x.y. ",
". z.A.B.j.C.D.k.E.. F.G.u.H.I.. J.K.K.L.M. ",
". N.O.P.Q.R.S.T.U.V.}.W.X.Y.Z.. `. +.+++@+ ",
" . . . . . . . . . . . . . . . . . . }. ",
" ",
" ",
" ",
" "};

3
lisp/toolbar/tool-bar.el
View file

@ -223,7 +223,8 @@ MAP must contain appropriate binding for `[menu-bar]' which holds a keymap."
;; might inadvertently click that button.
;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
(tool-bar-add-item-from-menu 'find-file "new")
(tool-bar-add-item-from-menu 'dired "open")
(tool-bar-add-item-from-menu 'find-file-existing "open")
(tool-bar-add-item-from-menu 'dired "diropen")
(tool-bar-add-item-from-menu 'kill-this-buffer "close")
(tool-bar-add-item-from-menu 'save-buffer "save" nil
:visible '(or buffer-file-name

Some files were not shown because too many files have changed in this diff Show more