Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-88

Merge from emacs--cvs-trunk--0

Patches applied:

 * emacs--cvs-trunk--0  (patch 569-579)

   - Update from CVS
   - Merge from gnus--rel--5.10

 * gnus--rel--5.10  (patch 129-132)

   - Update from CVS
   - Merge from emacs--cvs-trunk--0
This commit is contained in:
Miles Bader 2005-10-07 07:15:40 +00:00
commit 00e18f33ad
171 changed files with 6118 additions and 17181 deletions

View file

@ -1,3 +1,9 @@
2005-10-04 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* configure.in: Prefer Carbon if --enable-carbon-app or
--with-carbon is explicitly specified even when X11 is detected.
* configure: Regenerate.
2005-09-15 Ulf Jasper <ulf.jasper@web.de> 2005-09-15 Ulf Jasper <ulf.jasper@web.de>
* Makefile.in (install-arch-indep, uninstall): * Makefile.in (install-arch-indep, uninstall):

View file

@ -1,3 +1,7 @@
2005-10-01 Jason Rumney <jasonr@gnu.org>
* admin.el (set-version): Set version numbers in nt/emacs.rc.
2005-08-31 Romain Francoise <romain@orebokech.com> 2005-08-31 Romain Francoise <romain@orebokech.com>
* FOR-RELEASE: (New features): Remove vhdl-mode.el update * FOR-RELEASE: (New features): Remove vhdl-mode.el update

View file

@ -27,8 +27,6 @@ face name prefixes should be in it for good results.
* NEW FEATURES * NEW FEATURES
** Update Speedbar.
** Rework how the fringe "angle" bitmap at at bottom of buffer is ** Rework how the fringe "angle" bitmap at at bottom of buffer is
shown to include an indication of whether the last line has a NL or not. shown to include an indication of whether the last line has a NL or not.
[Assigned to KFS] [Assigned to KFS]
@ -67,6 +65,8 @@ back burner waiting for a legal comment or an alternate implementation
* BUGS * BUGS
* Pierre Albarede's Aug 30 bug report about C-v and long lines.
** Make a new interface for specifying window configurations ** Make a new interface for specifying window configurations
so that we can fix bugs in balance-windows. so that we can fix bugs in balance-windows.

View file

@ -87,7 +87,36 @@ Root must be the root of an Emacs source tree."
(submatch (1+ (in "0-9.")))))) (submatch (1+ (in "0-9."))))))
(set-version-in-file root "lispref/elisp.texi" version (set-version-in-file root "lispref/elisp.texi" version
(rx (and "EMACSVER" (1+ space) (rx (and "EMACSVER" (1+ space)
(submatch (1+ (in "0-9."))))))) (submatch (1+ (in "0-9."))))))
;; nt/emacs.rc also contains the version number, but in an awkward
;; format. It must contain four components, separated by commas, and
;; in two places those commas are followed by space, in two other
;; places they are not.
(let* ((version-components (append (split-string version "\\.")
'("0" "0")))
(comma-version
(concat (car version-components) ","
(cadr version-components) ","
(cadr (cdr version-components)) ","
(cadr (cdr (cdr version-components)))))
(comma-space-version
(concat (car version-components) ", "
(cadr version-components) ", "
(cadr (cdr version-components)) ", "
(cadr (cdr (cdr version-components))))))
(set-version-in-file root "nt/emacs.rc" comma-version
(rx (and "FILEVERSION" (1+ space)
(submatch (1+ (in "0-9,"))))))
(set-version-in-file root "nt/emacs.rc" comma-version
(rx (and "PRODUCTVERSION" (1+ space)
(submatch (1+ (in "0-9,"))))))
(set-version-in-file root "nt/emacs.rc" comma-space-version
(rx (and "\"FileVersion\"" (0+ space) ?, (0+ space)
?\" (submatch (1+ (in "0-9, "))) "\\0\"")))
(set-version-in-file root "nt/emacs.rc" comma-space-version
(rx (and "\"ProductVersion\"" (0+ space) ?,
(0+ space) ?\" (submatch (1+ (in "0-9, ")))
"\\0\"")))))
;;; arch-tag: 4ea83636-2293-408b-884e-ad64f22a3bf5 ;;; arch-tag: 4ea83636-2293-408b-884e-ad64f22a3bf5
;; admin.el ends here. ;; admin.el ends here.

98
configure vendored
View file

@ -8197,52 +8197,9 @@ else
fi fi
fi fi
case "${window_system}" in
x11 )
HAVE_X_WINDOWS=yes
HAVE_X11=yes
case "${with_x_toolkit}" in
athena | lucid ) USE_X_TOOLKIT=LUCID ;;
motif ) USE_X_TOOLKIT=MOTIF ;;
gtk ) with_gtk=yes
USE_X_TOOLKIT=none ;;
no ) USE_X_TOOLKIT=none ;;
* ) USE_X_TOOLKIT=maybe ;;
esac
;;
none )
HAVE_X_WINDOWS=no
HAVE_X11=no
USE_X_TOOLKIT=none
;;
esac
### If we're using X11, we should use the X menu package.
HAVE_MENUS=no
case ${HAVE_X11} in
yes ) HAVE_MENUS=yes ;;
esac
if test "${opsys}" = "hpux9"; then
case "${x_libraries}" in
*X11R4* )
opsysfile="s/hpux9-x11r4.h"
;;
esac
fi
if test "${opsys}" = "hpux9shr"; then
case "${x_libraries}" in
*X11R4* )
opsysfile="s/hpux9shxr4.h"
;;
esac
fi
HAVE_CARBON=no HAVE_CARBON=no
if test "${HAVE_X11}" != "yes"; then if test "${with_carbon}" != no; then
if test "${with_carbon}" != "no"; then if test "${ac_cv_header_Carbon_Carbon_h+set}" = set; then
if test "${ac_cv_header_Carbon_Carbon_h+set}" = set; then
echo "$as_me:$LINENO: checking for Carbon/Carbon.h" >&5 echo "$as_me:$LINENO: checking for Carbon/Carbon.h" >&5
echo $ECHO_N "checking for Carbon/Carbon.h... $ECHO_C" >&6 echo $ECHO_N "checking for Carbon/Carbon.h... $ECHO_C" >&6
if test "${ac_cv_header_Carbon_Carbon_h+set}" = set; then if test "${ac_cv_header_Carbon_Carbon_h+set}" = set; then
@ -8384,8 +8341,58 @@ if test $ac_cv_header_Carbon_Carbon_h = yes; then
fi fi
fi
if test "${window_system}" = x11 && test "${HAVE_CARBON}" = yes; then
if test "${with_carbon+set}" != set \
&& test "${carbon_appdir_x+set}" != set; then
HAVE_CARBON=no
fi fi
fi fi
if test "${HAVE_CARBON}" = yes; then
window_system=mac
fi
case "${window_system}" in
x11 )
HAVE_X_WINDOWS=yes
HAVE_X11=yes
case "${with_x_toolkit}" in
athena | lucid ) USE_X_TOOLKIT=LUCID ;;
motif ) USE_X_TOOLKIT=MOTIF ;;
gtk ) with_gtk=yes
USE_X_TOOLKIT=none ;;
no ) USE_X_TOOLKIT=none ;;
* ) USE_X_TOOLKIT=maybe ;;
esac
;;
mac | none )
HAVE_X_WINDOWS=no
HAVE_X11=no
USE_X_TOOLKIT=none
;;
esac
### If we're using X11, we should use the X menu package.
HAVE_MENUS=no
case ${HAVE_X11} in
yes ) HAVE_MENUS=yes ;;
esac
if test "${opsys}" = "hpux9"; then
case "${x_libraries}" in
*X11R4* )
opsysfile="s/hpux9-x11r4.h"
;;
esac
fi
if test "${opsys}" = "hpux9shr"; then
case "${x_libraries}" in
*X11R4* )
opsysfile="s/hpux9shxr4.h"
;;
esac
fi
### Compute the unexec source name from the object name. ### Compute the unexec source name from the object name.
UNEXEC_SRC="`echo ${unexec} | sed 's/\.o/.c/'`" UNEXEC_SRC="`echo ${unexec} | sed 's/\.o/.c/'`"
@ -12716,7 +12723,6 @@ cat >>confdefs.h <<\_ACEOF
#define HAVE_CARBON 1 #define HAVE_CARBON 1
_ACEOF _ACEOF
window_system=mac
## Specify the install directory ## Specify the install directory
carbon_appdir= carbon_appdir=
if test "${carbon_appdir_x}" != ""; then if test "${carbon_appdir_x}" != ""; then

View file

@ -1668,6 +1668,20 @@ else
fi fi
fi fi
HAVE_CARBON=no
if test "${with_carbon}" != no; then
AC_CHECK_HEADER(Carbon/Carbon.h, HAVE_CARBON=yes)
fi
if test "${window_system}" = x11 && test "${HAVE_CARBON}" = yes; then
if test "${with_carbon+set}" != set \
&& test "${carbon_appdir_x+set}" != set; then
HAVE_CARBON=no
fi
fi
if test "${HAVE_CARBON}" = yes; then
window_system=mac
fi
case "${window_system}" in case "${window_system}" in
x11 ) x11 )
HAVE_X_WINDOWS=yes HAVE_X_WINDOWS=yes
@ -1686,7 +1700,7 @@ dnl make this decision later: use the toolkit if we have X11R5 or newer.
* ) USE_X_TOOLKIT=maybe ;; * ) USE_X_TOOLKIT=maybe ;;
esac esac
;; ;;
none ) mac | none )
HAVE_X_WINDOWS=no HAVE_X_WINDOWS=no
HAVE_X11=no HAVE_X11=no
USE_X_TOOLKIT=none USE_X_TOOLKIT=none
@ -1715,13 +1729,6 @@ if test "${opsys}" = "hpux9shr"; then
esac esac
fi fi
HAVE_CARBON=no
if test "${HAVE_X11}" != "yes"; then
if test "${with_carbon}" != "no"; then
AC_CHECK_HEADER(Carbon/Carbon.h, HAVE_CARBON=yes)
fi
fi
### Compute the unexec source name from the object name. ### Compute the unexec source name from the object name.
UNEXEC_SRC="`echo ${unexec} | sed 's/\.o/.c/'`" UNEXEC_SRC="`echo ${unexec} | sed 's/\.o/.c/'`"
@ -2345,7 +2352,6 @@ AC_CHECK_HEADER(malloc/malloc.h, AC_DEFINE(HAVE_MALLOC_MALLOC_H, 1, [Define to 1
### Use Mac OS X Carbon API to implement GUI. ### Use Mac OS X Carbon API to implement GUI.
if test "${HAVE_CARBON}" = "yes"; then if test "${HAVE_CARBON}" = "yes"; then
AC_DEFINE(HAVE_CARBON, 1, [Define to 1 if you are using the Carbon API on Mac OS X.]) AC_DEFINE(HAVE_CARBON, 1, [Define to 1 if you are using the Carbon API on Mac OS X.])
window_system=mac
## Specify the install directory ## Specify the install directory
carbon_appdir= carbon_appdir=
if test "${carbon_appdir_x}" != ""; then if test "${carbon_appdir_x}" != ""; then

View file

@ -1,3 +1,39 @@
2005-10-02 Stefan Monnier <monnier@iro.umontreal.ca>
* TODO: Clarify the local variables entry.
2005-09-30 Bill Wohler <wohler@newt.com>
Moved MH-E image files from toolbar and mail directories into
etc/images.
* images/mail: New directory.
* images/mail/reply.*: Moved here from lisp/mail/reply2*.
* images/mail/alias.*, images/mail/refile.*, images/mail/repack.*:
* images/mail/reply*: Moved here from lisp/toolbar.
* images/execute.*, images/highlight.*, images/mh-logo.xpm:
* images/page-down.*, images/show.*, images/widen.*: Moved here
from lisp/toolbar.
* images/refresh.*: Moved here from lisp/toolbar/rescan.*.
Use GNOME 2.10's refresh icon.
* images/README: New file that indicates which icons came from
GNOME (see lisp/toolbar/README).
2005-09-30 Romain Francoise <romain@orebokech.com>
* NEWS: Mention changes to `read-buffer'.
2005-09-30 Chong Yidong <cyd@stupidchicken.com>
* images/ezimage: New directory.
* images/ezimage/*.xpm: Add images used by speedbar.el.
2005-09-30 David Ponce <david@dponce.com> 2005-09-30 David Ponce <david@dponce.com>
* NEWS: Update recentf changes. * NEWS: Update recentf changes.
@ -9,8 +45,7 @@
2005-09-27 Jay Belanger <belanger@truman.edu> 2005-09-27 Jay Belanger <belanger@truman.edu>
* calccard.tex: Update `versionnumber', remove `versiondate'. * calccard.tex: Update `versionnumber', remove `versiondate'.
(Error Recovery): Refer to "initial state" rather than "default (Error Recovery): Refer to "initial state" rather than "default state".
state".
(Algebra): Mention LaTeX language mode. (Algebra): Mention LaTeX language mode.
(Programming): Delete reference to "Z =". (Programming): Delete reference to "Z =".
@ -25,8 +60,7 @@
2005-09-15 Kenichi Handa <handa@m17n.org> 2005-09-15 Kenichi Handa <handa@m17n.org>
* PROBLEMS: Fix the paragraph describing the limitation of * PROBLEMS: Fix the paragraph describing the limitation of UTF-8/16/7.
UTF-8/16/7.
2005-09-14 Romain Francoise <romain@orebokech.com> 2005-09-14 Romain Francoise <romain@orebokech.com>
@ -128,12 +162,11 @@
2005-07-03 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 2005-07-03 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* PROBLEMS (Fedora Core 4 GNU/Linux: Segfault during dumping): * PROBLEMS (Fedora Core 4 GNU/Linux: Segfault during dumping):
Added it again. Add it again.
2005-06-29 Carsten Dominik <dominik@science.uva.nl> 2005-06-29 Carsten Dominik <dominik@science.uva.nl>
* NEWS: Added an entry for Org-mode, and a change entry for * NEWS: Add an entry for Org-mode, and a change entry for reftex-mode.
reftex-mode.
2005-06-28 Richard M. Stallman <rms@gnu.org> 2005-06-28 Richard M. Stallman <rms@gnu.org>

View file

@ -3774,6 +3774,12 @@ If the variable is itself nil, then `frame-or-buffer-changed-p' uses,
for compatibility, an internal variable which exists only for this for compatibility, an internal variable which exists only for this
purpose. purpose.
+++
*** The function `read-buffer' follows the convention for reading from
the minibuffer with a default value: if DEF is non-nil, the minibuffer
prompt provided in PROMPT is edited to show the default value provided
in DEF before the terminal colon and space.
** Local variables lists: ** Local variables lists:
+++ +++
@ -4421,6 +4427,9 @@ buffer.
If non-nil, that says to preserve the window's current margin, fringe, If non-nil, that says to preserve the window's current margin, fringe,
and scroll-bar settings. and scroll-bar settings.
+++
*** The new function `window-split-tree' returns a frame's window split tree.
+++ +++
** Customizable fringe bitmaps ** Customizable fringe bitmaps

View file

@ -47,7 +47,7 @@ to the FSF.
** Implement something better than the current Refill mode. This ** Implement something better than the current Refill mode. This
probably needs some primitive support. probably needs some primitive support.
** Add a command to make a local variables list in the current buffer ** Add a command to make a "Local Variables" section in the current buffer
and/or add a variable to the list. and/or add a variable to the list.
** Implement primitive and higher-level functions to allow filling ** Implement primitive and higher-level functions to allow filling

5
etc/images/README Normal file
View file

@ -0,0 +1,5 @@
The following icons are from GNOME 2.10:
refresh.pbm, refresh.xpm
They are not part of Emacs, but distributed and used by Emacs.

View file

@ -0,0 +1,20 @@
/* XPM */
static char * sb_obj_xpm[] = {
"15 15 2 1",
" c None",
". c #000CFF",
" .. . .. . ",
". . . . . . ",
". . . . . . ",
". . . . . . ",
" .. . .. . ",
" ",
". .. . .. ",
". . . . . . ",
". . . . . . ",
". . . . . . ",
". .. . .. ",
" ",
" .. . .. . ",
". . . . . . ",
". . . . . . "};

View file

@ -0,0 +1,21 @@
/* XPM */
static char * sb_objod_xpm[] = {
"15 15 3 1",
" c None",
". c #000CFF",
"+ c #FFFA00",
" .. . .. . ",
". .++ . . . ",
". .++ . . . ",
". . ++. . . ",
" .. ++ .. . ",
" ++ ",
". ..++. .. ",
". . .++ . . ",
". . .++ . . ",
". . .++ . . ",
". .. . .. ",
" ++ ",
" .. . ++. . ",
". . . . . . ",
". . . . . . "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_box_minus_xpm[] = {
"20 15 4 1",
" c None",
". c #000000",
"+ c #828282",
"@ c #D19200",
"...+ +..+ ",
".@@.+ +.@.+",
"+.@@.+ +.@@@.",
"+.@@@.+++++++++.@@..",
" +..@............@.+",
" +.@..@@@@@@@@@@@..+",
" +.@@..............+",
" +.@@.@@@@@@@@@@@@.+",
" +.@@.@@@@@@@@@@@@.+",
" +.@@.@@@......@@@.+",
" +.@@.@@@......@@@.+",
" +.@.@@@@@@@@@@@@.+",
" +..@@@@@@@@@@@@.+",
" +..............+",
" ++++++++++++++ "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_box_plus_xpm[] = {
"20 15 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #D19200",
" ",
" .............. ",
" .++++++++++++++. ",
" .++@@@@@@+@@@@@+. ",
" .+@+@@@@@@+@@@@@+. ",
" .+@@++++++++++++++.",
" .+@@+@@@@@@@@@@@@+.",
" .+@@+@@@@@++@@@@@+.",
" .+@@+@@@@@++@@@@@+.",
" .+@@+@@@++++++@@@+.",
" .+@@+@@@++++++@@@+.",
" .+@+@@@@@++@@@@@+.",
" .++@@@@@++@@@@@+.",
" .++++++++++++++.",
" .............. "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_box_xpm[] = {
"20 15 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ",
" ............... ",
" .++++++++++++++. ",
" .++@@@@@@+@@@@@+. ",
" .+@+@@@@@@+@@@@@+. ",
" .+@@++++++++++++++.",
" .+@@+@@@@@@@@@@@@+.",
" .+@@+@@@@@@@@@@@@+.",
" .+@@+@@@@@@@@@@@@+.",
" .+@@+@@@@@@@@@@@@+.",
" .+@@+@@@@@@@@@@@@+.",
" .+@+@@@@@@@@@@@@+.",
". .++@@@@@@@@@@@@+.",
" .++++++++++++++.",
" .............. "};

View file

@ -0,0 +1,20 @@
/* XPM */
static char * sb_chk_xpm[] = {
"15 15 2 1",
" c None",
". c #FF0000",
" ",
" . . .. ",
" . . . ",
" . . . . ",
" . .. . ",
" .. ",
" .. ",
" ... .. ",
" ... .. ",
" .... .. ",
" ... .. ",
" .... ",
" ... ",
" . ",
" "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * sb_dir_minus_xpm[] = {
"20 15 5 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #DBDB00",
"# c #FFF993",
" ....... ",
".+++++++. ",
".+@@@@@@+......... ",
".+@@@@@@@++++++++. ",
".+@@@@@@@@@@@@@@+...",
".+@@++++++++++++++++",
".+@@+##############+",
".+@+##############+.",
".+@+####++++++####+.",
".+@+####++++++####+.",
".+@+##############+.",
".++##############+..",
".++##############+. ",
".+++++++++++++++++. ",
" ................. "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * sb_dir_plus_xpm[] = {
"20 15 5 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #DBDB00",
"# c #FFF993",
" ....... ",
".+++++++. ",
".+@@@@@@+.......... ",
".+@@@@@@@++++++++++.",
".+@@@@@@@@@@@@@@@@+.",
".+#######++#####@@+.",
".+#######++######@+.",
".+#####++++++####@+.",
".+#####++++++####@+.",
".+#######++######@+.",
".+#######++######@+.",
".+###############@+.",
".+###############@+.",
".++++++++++++++++++.",
" .................. "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * sb_dir_xpm[] = {
"20 15 5 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #DBDB00",
"# c #FFF993",
" ....... ",
".+++++++. ",
".+@@@@@@+.......... ",
".+@@@@@@@++++++++++.",
".+@@@@@@@@@@@@@@@@+.",
".+##############@@+.",
".+###############@+.",
".+###############@+.",
".+###############@+.",
".+###############@+.",
".+###############@+.",
".+###############@+.",
".+###############@+.",
".++++++++++++++++++.",
" .................. "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * sb_doc_minus_xpm[] = {
"15 15 5 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #5A818B",
"# c #FFFFFF",
" ....... ",
" .+++++++. ",
" .+@@@@@@+. ",
" .+@@@@@@+#. ",
" .+@@@@@@+#+.",
" .+@####@+##+.",
" .+@@@@@@@+#+. ",
" .+@@@@@@+##+. ",
".++++@@@@+#+. ",
".+###++++##+. ",
".+########+. ",
".++#######+. ",
" ..++++##+. ",
" ....+++. ",
" ... "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * sb_doc_plus_xpm[] = {
"15 15 5 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #5A818B",
"# c #FFFFFF",
" ....... ",
" .+++++++. ",
" .+@@@@@@+. ",
" .+@@#@@@+#. ",
" .+@@#@@@+#+.",
" .+@#####+##+.",
" .+@@@@#@@+#+. ",
" .+@@@@#@+##+. ",
".++++@@@@+#+. ",
".+###++++##+. ",
".+########+. ",
".++#######+. ",
" ..++++##+. ",
" ....+++. ",
" ... "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * sb_doc_xpm[] = {
"15 15 5 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #5A818B",
"# c #FFFFFF",
" ....... ",
" .+++++++. ",
" .+@@@@@@+. ",
" .+@@@@@@+#. ",
" .+@@@@@@+#+.",
" .+@@@@@@+##+.",
" .+@@@@@@@+#+. ",
" .+@@@@@@+##+. ",
".++++@@@@+#+. ",
".+###++++##+. ",
".+########+. ",
".+########+. ",
".++++++##+. ",
" ......+++. ",
" ... "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_info_xpm[] = {
"10 15 4 1",
" c None",
". c #BEBEBE",
"+ c #0000FF",
"@ c #FFFFFF",
" .. ",
" ..+++. ",
" .+++@++. ",
" .+++++++ ",
" .+++++++ ",
".++@@@++++",
".++++@++++",
".++++@++++",
".++++@++++",
" .+++@++++",
" .+++@+++ ",
" .+@@@@@+ ",
" .+++++++ ",
" .+++++ ",
" ++ "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * key_xpm[] = {
"16 16 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ........ ",
" ..++++++.. ",
" .+@@@@@@+. ",
" .+@@++@@+. ",
" .+@@@@@@+. ",
" .+@@@@@@+. ",
" .+@@@@@@+. ",
" .+@@@@+. ",
" .+@@+. ",
" .+@@@+. ",
" .+@@+. ",
" .+@@+. ",
" .+@@@+. ",
" .+@@+. ",
" .++. ",
" .. "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_label_xpm[] = {
"10 16 3 1",
" c None",
". c gray",
"+ c blue",
" .....",
" ..+++++",
" .+++++++",
" .++++++++",
" .++++++++",
".+++++++++",
".+++++++++",
".+++++++++",
".+++++++++",
".+++++++++",
".+++++++++",
".+++++++++",
".+++++++++",
".+++++++++",
".+++++++++",
".+++++++++"};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * lock_xpm[] = {
"16 16 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ........ ",
" ..++++++.. ",
" .++....++. ",
" .+......+. ",
" ..+......+.. ",
" ..++++++++++..",
" .++@@@@@@@@++.",
" .+@@@@@@@@@@+.",
" .+@@@@@@@@@@+.",
" .+@@@++++@@@+.",
" .+@@@@++@@@@+.",
" .+@@@@@@@@@@+.",
" .+@@@@++@@@@+.",
" .+@@@@@@@@@@+.",
" .++++++++++++.",
" .............."};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_mail_xpm[] = {
"20 15 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFFFFF",
"................... ",
".++++++++++++++++++.",
".++@@@@@@@@@@@@@@++.",
".+@++@@@@@@@@@@++@+.",
".+@@@++@@@@@@++@@@+.",
".+@@@@@++@@++@@@@@+.",
".+@@@@@@@++@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@@@+@@@@@@+@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@+@@@@@@@@@@+@@+.",
".+@@@@@@@@@@@@@@@@+.",
".++@@@@@@@@@@@@@@++.",
".++++++++++++++++++.",
" .................. "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * sb_pg_minus_xpm[] = {
"20 15 5 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFFFFF",
"# c #ADADAD",
" ............ ",
" .++++++++++++.",
" .++@@@@@@@@@@+.",
" .+#+@@@@@@@@@@+.",
" .+##+@@@@@@@@@@+.",
" .+###+@@@@@@@@@@+.",
" .+####+@@@@@@@@@@+.",
".+++++++@++++++@@@+.",
".+@@@@@@@++++++@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".++++++++++++++++++.",
" .................. "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * sb_pg_plus_xpm[] = {
"20 15 5 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFFFFF",
"# c #ADADAD",
" ............ ",
" .++++++++++++.",
" .++@@@@@@@@@@+.",
" .+#+@@@@@@@@@@+.",
" .+##+@@@@@@@@@@+.",
" .+###+@@@++@@@@@+.",
" .+####+@@@++@@@@@+.",
".+++++++@++++++@@@+.",
".+@@@@@@@++++++@@@+.",
".+@@@@@@@@@++@@@@@+.",
".+@@@@@@@@@++@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".++++++++++++++++++.",
" .................. "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * sb_pg_xpm[] = {
"20 15 5 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFFFFF",
"# c #ADADAD",
" ............ ",
" .++++++++++++.",
" .++@@@@@@@@@@+.",
" .+#+@@@@@@@@@@+.",
" .+##+@@@@@@@@@@+.",
" .+###+@@@@@@@@@@+.",
" .+####+@@@@@@@@@@+.",
".+++++++@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".++++++++++++++++++.",
" .................. "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_tag_gt_xpm[] = {
"20 15 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ",
" ",
" ............... ",
" .+++++++++++++++.",
" .+@@@@@++@@@@@@@+.",
" .+@@@@@@+++@@@@@@+.",
".+@@@@@@@++++@@@@@+.",
".+@++@@@@+++++@@@@+.",
".+@++@@@@+++++.@@@+.",
".+@@@@@@@++++.@@@@+.",
" .+@@@@@@+++.@@@@@+.",
" .+@@@@@++.@@@@@@+.",
". .++++++.++++++++.",
" ............... ",
" "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_tag__xpm[] = {
"20 15 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ",
" ",
" ............... ",
" .+++++++++++++++.",
" .+@@@@@@@@@@@@@@+.",
" .+@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@++@@++++++@@@@@+.",
".+@++@@++++++@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
" .+@@@@@@@@@@@@@@@+.",
" .+@@@@@@@@@@@@@@+.",
". .+++++++++++++++.",
" ............... ",
" "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_tag+_xpm[] = {
"20 15 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ",
" ",
" ............... ",
" .+++++++++++++++.",
" .+@@@@@@@@@@@@@@+.",
" .+@@@@@@++@@@@@@@+.",
".+@@@@@@@++@@@@@@@+.",
".+@++@@++++++@@@@@+.",
".+@++@@++++++@@@@@+.",
".+@@@@@@@++@@@@@@@+.",
" .+@@@@@@++@@@@@@@+.",
" .+@@@@@@@@@@@@@@+.",
". .+++++++++++++++.",
" ............... ",
" "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_tag_type_xpm[] = {
"20 15 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ",
" ",
" ............... ",
" .+++++++++++++++.",
" .+@@@@@@@@@@@@@@+.",
" .+@@@@@@++++++@@@+.",
".+@@@@@@@++++++@@@+.",
".+@++@@@@@@++@@@@@+.",
".+@++@@@@@@++@@@@@+.",
".+@@@@@@@@@++@@@@@+.",
" .+@@@@@@@@++@@@@@+.",
" .+@@@@@@@@@@@@@@+.",
". .+++++++++++++++.",
" ............... ",
" "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_tag_v_xpm[] = {
"20 15 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ",
" ",
" ............... ",
" .+++++++++++++++.",
" .+@@@@@@@@@@@@@@+.",
" .+@@@++++++++++.@+.",
".+@@@@@++++++++.@@+.",
".+@++@@@++++++.@@@+.",
".+@++@@@@++++.@@@@+.",
".+@@@@@@@@++.@@@@@+.",
" .+@@@@@@@@.@@@@@@+.",
" .+@@@@@@@@@@@@@@+.",
". .+++++++++++++++.",
" ............... ",
" "};

View file

@ -0,0 +1,22 @@
/* XPM */
static char * sb_tag_xpm[] = {
"20 15 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ",
" ",
" ............... ",
" .+++++++++++++++.",
" .+@@@@@@@@@@@@@@+.",
" .+@@@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
".+@++@@@@@@@@@@@@@+.",
".+@++@@@@@@@@@@@@@+.",
".+@@@@@@@@@@@@@@@@+.",
" .+@@@@@@@@@@@@@@@+.",
" .+@@@@@@@@@@@@@@+.",
". .+++++++++++++++.",
" ............... ",
" "};

View file

@ -0,0 +1,23 @@
/* XPM */
static char * unlock_xpm[] = {
"16 16 4 1",
" c None",
". c #828282",
"+ c #000000",
"@ c #FFF993",
" ....... ",
"..+++++.. ",
".++...++. ",
".+.....+. ",
".+.....+........",
"....++++++++++..",
" .++@@@@@@@@++.",
" .+@@@@@@@@@@+.",
" .+@@@@@@@@@@+.",
" .+@@@++++@@@+.",
" .+@@@@++@@@@+.",
" .+@@@@@@@@@@+.",
" .+@@@@++@@@@+.",
" .+@@@@@@@@@@+.",
" .++++++++++++.",
" .............."};

BIN
etc/images/refresh.pbm Normal file

Binary file not shown.

113
etc/images/refresh.xpm Normal file
View file

@ -0,0 +1,113 @@
/* XPM */
static char * refresh_xpm[] = {
"24 24 86 1",
" c None",
". c #000000",
"+ c #F3F6F8",
"@ c #C8D4DF",
"# c #F7F9FA",
"$ c #0D110C",
"% c #6286A5",
"& c #A0B6C9",
"* c #C9D5E0",
"= c #F2F5F7",
"- c #172116",
"; c #819EB6",
"> c #CAD6E1",
", c #CCD7E1",
"' c #CED9E3",
") c #F6F8F9",
"! c #7192AE",
"~ c #587B99",
"{ c #CDD8E2",
"] c #CFDAE4",
"^ c #D3DDE6",
"/ c #D5DEE6",
"( c #ADC0D0",
"_ c #90A9BF",
": c #537490",
"< c #23323E",
"[ c #85A1B8",
"} c #5E83A3",
"| c #6084A3",
"1 c #6689A7",
"2 c #678AA8",
"3 c #48657D",
"4 c #A8BCCD",
"5 c #7393AE",
"6 c #6B8DAA",
"7 c #5C81A1",
"8 c #5D82A2",
"9 c #6588A6",
"0 c #435F76",
"a c #B1C3D2",
"b c #50718D",
"c c #9FB5C8",
"d c #94ACC1",
"e c #425D73",
"f c #435E74",
"g c #B4C5D3",
"h c #6C8EAB",
"i c #C4D2DD",
"j c #5B80A0",
"k c #456178",
"l c #7595B0",
"m c #BFCEDA",
"n c #597D9C",
"o c #A3B8CA",
"p c #B0C2D1",
"q c #86A2B9",
"r c #6E8FAB",
"s c #E1E8EE",
"t c #B9C9D6",
"u c #6387A6",
"v c #4C6B85",
"w c #7F9DB6",
"x c #BCCCD9",
"y c #DDE5EC",
"z c #E4EAEF",
"A c #D8E1E9",
"B c #D1DBE4",
"C c #C7D3DE",
"D c #B7C8D6",
"E c #7091AD",
"F c #537592",
"G c #9DB3C6",
"H c #8CA7BD",
"I c #304353",
"J c #4E6E89",
"K c #829FB7",
"L c #92ABC0",
"M c #C5D3DE",
"N c #7C9AB3",
"O c #5A7E9D",
"P c #47647C",
"Q c #6185A4",
"R c #5B7F9E",
"S c #4F6F8A",
"T c #405A71",
"U c #283926",
" . ",
" .. ",
" .+. ",
" ....@#. ",
" $%&@@**=. .. ",
" -;@@**>,'). .!~. ",
" .%@**>,{]^/(. ._:. ",
" <&@[}}|%123. .4. ",
".5@678|%920. .ab. ",
".cd7e...1f. . .gh. ",
".ijb. .k. .. .al. ",
".mn. .. .'. .op5. ",
".qr. . .*s...at4u. ",
".vw. .xyzyABCDEF. ",
" .G. .p'B,@ixaH2I. ",
" .JK. .LM@,>>MmNOP. ",
" .F9. .9|%Q|}7RS.. ",
" .. .|R~~nJT.. ",
" .j~.... ",
" UO. ",
" .. ",
" . ",
" ",
" "};

File diff suppressed because it is too large Load diff

View file

@ -742,7 +742,7 @@ language you are using."
;; natural bindings for terminal keycaps --- defined in X keysym order ;; natural bindings for terminal keycaps --- defined in X keysym order
(define-key global-map [C-S-backspace] 'kill-whole-line) (define-key global-map [C-S-backspace] 'kill-whole-line)
(define-key global-map [home] 'beginning-of-line) (define-key global-map [home] 'move-beginning-of-line)
(define-key global-map [C-home] 'beginning-of-buffer) (define-key global-map [C-home] 'beginning-of-buffer)
(define-key global-map [M-home] 'beginning-of-buffer-other-window) (define-key global-map [M-home] 'beginning-of-buffer-other-window)
(define-key esc-map [home] 'beginning-of-buffer-other-window) (define-key esc-map [home] 'beginning-of-buffer-other-window)
@ -762,7 +762,7 @@ language you are using."
(define-key global-map [M-prior] 'scroll-other-window-down) (define-key global-map [M-prior] 'scroll-other-window-down)
(define-key esc-map [prior] 'scroll-other-window-down) (define-key esc-map [prior] 'scroll-other-window-down)
(define-key esc-map [?\C-\S-v] 'scroll-other-window-down) (define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
(define-key global-map [end] 'end-of-line) (define-key global-map [end] 'move-end-of-line)
(define-key global-map [C-end] 'end-of-buffer) (define-key global-map [C-end] 'end-of-buffer)
(define-key global-map [M-end] 'end-of-buffer-other-window) (define-key global-map [M-end] 'end-of-buffer-other-window)
(define-key esc-map [end] 'end-of-buffer-other-window) (define-key esc-map [end] 'end-of-buffer-other-window)

View file

@ -195,7 +195,7 @@ STRING is the description of the appointment.
FLAG, if non-nil, says that the element was made with `appt-add' FLAG, if non-nil, says that the element was made with `appt-add'
so calling `appt-make-list' again should preserve it.") so calling `appt-make-list' again should preserve it.")
(defconst appt-max-time 1439 (defconst appt-max-time (1- (* 24 60))
"11:59pm in minutes - number of minutes in a day minus 1.") "11:59pm in minutes - number of minutes in a day minus 1.")
(defvar appt-mode-string nil (defvar appt-mode-string nil
@ -484,13 +484,15 @@ Usually just deletes the appointment buffer."
lowest-window w))))) lowest-window w)))))
(select-window lowest-window))) (select-window lowest-window)))
(defconst appt-time-regexp
"[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?")
;;;###autoload ;;;###autoload
(defun appt-add (new-appt-time new-appt-msg) (defun appt-add (new-appt-time new-appt-msg)
"Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG. "Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG.
The time should be in either 24 hour format or am/pm format." The time should be in either 24 hour format or am/pm format."
(interactive "sTime (hh:mm[am/pm]): \nsMessage: ") (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
(unless (string-match "[0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?" (unless (string-match appt-time-regexp new-appt-time)
new-appt-time)
(error "Unacceptable time-string")) (error "Unacceptable time-string"))
(let* ((appt-time-string (concat new-appt-time " " new-appt-msg)) (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
(appt-time (list (appt-convert-time new-appt-time))) (appt-time (list (appt-convert-time new-appt-time)))
@ -577,16 +579,14 @@ appointment package (if it is not already active)."
(calendar-date-equal (calendar-date-equal
(calendar-current-date) (car (car entry-list)))) (calendar-current-date) (car (car entry-list))))
(let ((time-string (cadr (car entry-list)))) (let ((time-string (cadr (car entry-list))))
(while (string-match (while (string-match appt-time-regexp time-string)
"\\([0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?\\).*"
time-string)
(let* ((beg (match-beginning 0)) (let* ((beg (match-beginning 0))
;; Get just the time for this appointment. ;; Get just the time for this appointment.
(only-time (match-string 1 time-string)) (only-time (match-string 0 time-string))
;; Find the end of this appointment ;; Find the end of this appointment
;; (the start of the next). ;; (the start of the next).
(end (string-match (end (string-match
"^[ \t]*[0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?" (concat "\n[ \t]*" appt-time-regexp)
time-string time-string
(match-end 0))) (match-end 0)))
;; Get the whole string for this appointment. ;; Get the whole string for this appointment.
@ -633,31 +633,23 @@ APPT-LIST is a list of the same format as `appt-time-msg-list'."
"Convert hour:min[am/pm] format to minutes from midnight. "Convert hour:min[am/pm] format to minutes from midnight.
A period (.) can be used instead of a colon (:) to separate the A period (.) can be used instead of a colon (:) to separate the
hour and minute parts." hour and minute parts."
(let ((conv-time 0) ;; Formats that should be accepted:
(hr 0) ;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am
(min 0)) (let ((min (if (string-match "[h:.]\\([0-9][0-9]\\)" time2conv)
(string-to-number (match-string 1 time2conv))
(string-match "[:.]\\([0-9][0-9]\\)" time2conv) 0))
(setq min (string-to-number (hr (if (string-match "[0-9]*[0-9]" time2conv)
(match-string 1 time2conv))) (string-to-number (match-string 0 time2conv))
0)))
(string-match "[0-9]?[0-9][:.]" time2conv)
(setq hr (string-to-number
(match-string 0 time2conv)))
;; convert the time appointment time into 24 hour time ;; convert the time appointment time into 24 hour time
(cond ((and (string-match "pm" time2conv) (< hr 12)) (cond ((and (string-match "pm" time2conv) (< hr 12))
(setq hr (+ 12 hr))) (setq hr (+ 12 hr)))
((and (string-match "am" time2conv) (= hr 12)) ((and (string-match "am" time2conv) (= hr 12))
(setq hr 0))) (setq hr 0)))
;; convert the actual time ;; convert the actual time into minutes.
;; into minutes for comparison (+ (* hr 60) min)))
;; against the actual time.
(setq conv-time (+ (* hr 60) min))
conv-time))
(defun appt-update-list () (defun appt-update-list ()
@ -719,5 +711,5 @@ ARG is positive, otherwise off."
(provide 'appt) (provide 'appt)
;;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347 ;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347
;;; appt.el ends here ;;; appt.el ends here

View file

@ -352,7 +352,7 @@ Any holidays are shown if `holidays-in-diary-buffer' is t."
(diary-display-hook 'ignore) (diary-display-hook 'ignore)
(diary-entries (diary-entries
(mapcar (lambda (x) (split-string (car (cdr x)) "\^M\\|\n")) (mapcar (lambda (x) (split-string (car (cdr x)) "\^M\\|\n"))
(diary-list-entries date 1))) (diary-list-entries date 1 'list-only)))
(holidays (if holidays-in-diary-buffer (holidays (if holidays-in-diary-buffer
(check-calendar-holidays date))) (check-calendar-holidays date)))
(title (concat "Diary entries " (title (concat "Diary entries "

View file

@ -271,20 +271,22 @@ search."
;; This can be removed once the kill/yank treatment of invisible text ;; This can be removed once the kill/yank treatment of invisible text
;; (see etc/TODO) is fixed. -- gm ;; (see etc/TODO) is fixed. -- gm
(defcustom diary-header-line-flag t (defcustom diary-header-line-flag t
"*If non-nil, `simple-diary-display' will show a header line. "If non-nil, `diary-simple-display' will show a header line.
The format of the header is specified by `diary-header-line-format'." The format of the header is specified by `diary-header-line-format'."
:group 'diary :group 'diary
:type 'boolean :type 'boolean
:version "22.1") :version "22.1")
(defvar diary-selective-display nil)
(defcustom diary-header-line-format (defcustom diary-header-line-format
'(:eval (calendar-string-spread '(:eval (calendar-string-spread
(list (if selective-display (list (if diary-selective-display
"Selective display active - press \"s\" in calendar \ "Selective display active - press \"s\" in calendar \
before edit/copy" before edit/copy"
"Diary")) "Diary"))
?\s (frame-width))) ?\s (frame-width)))
"*Format of the header line displayed by `simple-diary-display'. "Format of the header line displayed by `diary-simple-display'.
Only used if `diary-header-line-flag' is non-nil." Only used if `diary-header-line-flag' is non-nil."
:group 'diary :group 'diary
:type 'sexp :type 'sexp
@ -322,17 +324,17 @@ number of days of diary entries displayed."
:group 'diary) :group 'diary)
(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) (define-obsolete-function-alias 'list-diary-entries 'diary-list-entries)
(defun diary-list-entries (date number) (defun diary-list-entries (date number &optional list-only)
"Create and display a buffer containing the relevant lines in `diary-file'. "Create and display a buffer containing the relevant lines in `diary-file'.
The arguments are DATE and NUMBER; the entries selected are those The arguments are DATE and NUMBER; the entries selected are those
for NUMBER days starting with date DATE. The other entries are hidden for NUMBER days starting with date DATE. The other entries are hidden
using selective display. If NUMBER is less than 1, this function does nothing. using selective display. If NUMBER is less than 1, this function does nothing.
Returns a list of all relevant diary entries found, if any, in order by date. Returns a list of all relevant diary entries found, if any, in order by date.
The list entries have the form ((month day year) string specifier) where The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where
\(month day year) is the date of the entry, string is the entry text, and \(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and
specifier is the applicability. If the variable `diary-list-include-blanks' SPECIFIER is the applicability. If the variable `diary-list-include-blanks'
is t, this list includes a dummy diary entry consisting of the empty string) is t, this list includes a dummy diary entry consisting of the empty string
for a date with no diary entries. for a date with no diary entries.
After the list is prepared, the hooks `nongregorian-diary-listing-hook', After the list is prepared, the hooks `nongregorian-diary-listing-hook',
@ -354,7 +356,9 @@ These hooks have the following distinct roles:
add-hook to set this to ignore. add-hook to set this to ignore.
`diary-hook' is run last. This can be used for an appointment `diary-hook' is run last. This can be used for an appointment
notification function." notification function.
If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
(unless number (unless number
(setq number (if (vectorp number-of-diary-entries) (setq number (if (vectorp number-of-diary-entries)
(aref number-of-diary-entries (calendar-day-of-week date)) (aref number-of-diary-entries (calendar-day-of-week date))
@ -373,29 +377,20 @@ These hooks have the following distinct roles:
(set-buffer diary-buffer) (set-buffer diary-buffer)
(or (verify-visited-file-modtime diary-buffer) (or (verify-visited-file-modtime diary-buffer)
(revert-buffer t t)))) (revert-buffer t t))))
;; Setup things like the header-line-format and invisibility-spec.
(when (eq major-mode 'fundamental-mode) (diary-mode))
;; d-s-p is passed to the diary display function. ;; d-s-p is passed to the diary display function.
(let ((diary-saved-point (point))) (let ((diary-saved-point (point)))
(save-excursion (save-excursion
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))
(setq selective-display t)
(setq selective-display-ellipses nil)
(if diary-header-line-flag
(setq header-line-format diary-header-line-format))
(with-syntax-table diary-syntax-table (with-syntax-table diary-syntax-table
(let ((buffer-read-only nil) (let ((mark (regexp-quote diary-nonmarking-symbol)))
(diary-modified (buffer-modified-p))
(mark (regexp-quote diary-nonmarking-symbol)))
;; First and last characters must be ^M or \n for
;; selective display to work properly
(goto-char (1- (point-max)))
(if (not (looking-at "\^M\\|\n"))
(progn
(goto-char (point-max))
(insert "\^M")))
(goto-char (point-min)) (goto-char (point-min))
(if (not (looking-at "\^M\\|\n")) (unless list-only
(insert "\^M")) (let ((ol (make-overlay (point-min) (point-max) nil t nil)))
(subst-char-in-region (point-min) (point-max) ?\n ?\^M t) (set (make-local-variable 'diary-selective-display) t)
(overlay-put ol 'invisible 'diary)
(overlay-put ol 'evaporate t)))
(calendar-for-loop (calendar-for-loop
i from 1 to number do i from 1 to number do
(let ((month (extract-calendar-month date)) (let ((month (extract-calendar-month date))
@ -426,7 +421,7 @@ These hooks have the following distinct roles:
(regexp (regexp
(concat (concat
"\\(\\`\\|\^M\\|\n\\)" mark "?\\(" "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
(mapconcat 'eval date-form "\\)\\(") (mapconcat 'eval date-form "\\)\\(?:")
"\\)")) "\\)"))
(case-fold-search t)) (case-fold-search t))
(goto-char (point-min)) (goto-char (point-min))
@ -448,8 +443,9 @@ These hooks have the following distinct roles:
(while (looking-at " \\|\^I") (while (looking-at " \\|\^I")
(re-search-forward "\^M\\|\n" nil t)) (re-search-forward "\^M\\|\n" nil t))
(backward-char 1) (backward-char 1)
(subst-char-in-region date-start (unless list-only
(point) ?\^M ?\n t) (remove-overlays date-start (point)
'invisible 'diary))
(setq entry (buffer-substring entry-start (point)) (setq entry (buffer-substring entry-start (point))
temp (diary-pull-attrs entry file-glob-attrs) temp (diary-pull-attrs entry file-glob-attrs)
entry (nth 0 temp)) entry (nth 0 temp))
@ -467,23 +463,20 @@ These hooks have the following distinct roles:
(setq date (setq date
(calendar-gregorian-from-absolute (calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian date)))) (1+ (calendar-absolute-from-gregorian date))))
(setq entry-found nil))) (setq entry-found nil)))))
(set-buffer-modified-p diary-modified)))
(goto-char (point-min)) (goto-char (point-min))
(run-hooks 'nongregorian-diary-listing-hook (run-hooks 'nongregorian-diary-listing-hook
'list-diary-entries-hook) 'list-diary-entries-hook)
(if diary-display-hook (unless list-only
(run-hooks 'diary-display-hook) (if diary-display-hook
(simple-diary-display)) (run-hooks 'diary-display-hook)
(simple-diary-display)))
(run-hooks 'diary-hook) (run-hooks 'diary-hook)
diary-entries-list)))))) diary-entries-list))))))
(defun diary-unhide-everything () (defun diary-unhide-everything ()
(setq selective-display nil) (kill-local-variable 'diary-selective-display)
(let ((inhibit-read-only t) (remove-overlays (point-min) (point-max) 'invisible 'diary)
(modified (buffer-modified-p)))
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
(set-buffer-modified-p modified))
(kill-local-variable 'mode-line-format)) (kill-local-variable 'mode-line-format))
(defun include-other-diary-files () (defun include-other-diary-files ()
@ -603,8 +596,8 @@ This function is provided for optional use as the `diary-display-hook'."
(setq buffer-read-only t) (setq buffer-read-only t)
(display-buffer holiday-buffer) (display-buffer holiday-buffer)
(message "No diary entries for %s" date-string))) (message "No diary entries for %s" date-string)))
(save-excursion;; Prepare the fancy diary buffer. (with-current-buffer;; Prepare the fancy diary buffer.
(set-buffer (make-fancy-diary-buffer)) (make-fancy-diary-buffer)
(setq buffer-read-only nil) (setq buffer-read-only nil)
(let ((entry-list diary-entries-list) (let ((entry-list diary-entries-list)
(holiday-list) (holiday-list)
@ -673,10 +666,10 @@ This function is provided for optional use as the `diary-display-hook'."
(temp-face (make-symbol (temp-face (make-symbol
(apply (apply
'concat "temp-face-" 'concat "temp-face-"
(mapcar '(lambda (sym) (mapcar (lambda (sym)
(if (stringp sym) (if (stringp sym)
sym sym
(symbol-name sym))) (symbol-name sym)))
marks)))) marks))))
(faceinfo marks)) (faceinfo marks))
(make-face temp-face) (make-face temp-face)
@ -687,7 +680,7 @@ This function is provided for optional use as the `diary-display-hook'."
(setcar faceinfo nil) (setcar faceinfo nil)
(setcar (cdr faceinfo) nil)) (setcar (cdr faceinfo) nil))
(setq marks (delq nil marks)) (setq marks (delq nil marks))
;; Apply the font aspects ;; Apply the font aspects.
(apply 'set-face-attribute temp-face nil marks) (apply 'set-face-attribute temp-face nil marks)
(search-backward entry) (search-backward entry)
(overlay-put (overlay-put
@ -704,8 +697,7 @@ This function is provided for optional use as the `diary-display-hook'."
(defun make-fancy-diary-buffer () (defun make-fancy-diary-buffer ()
"Create and return the initial fancy diary buffer." "Create and return the initial fancy diary buffer."
(save-excursion (with-current-buffer (get-buffer-create fancy-diary-buffer)
(set-buffer (get-buffer-create fancy-diary-buffer))
(setq buffer-read-only nil) (setq buffer-read-only nil)
(calendar-set-mode-line "Diary Entries") (calendar-set-mode-line "Diary Entries")
(erase-buffer) (erase-buffer)
@ -726,26 +718,33 @@ The hooks given by the variable `print-diary-entries-hook' are called to do
the actual printing." the actual printing."
(interactive) (interactive)
(if (bufferp (get-buffer fancy-diary-buffer)) (if (bufferp (get-buffer fancy-diary-buffer))
(save-excursion (with-current-buffer (get-buffer fancy-diary-buffer)
(set-buffer (get-buffer fancy-diary-buffer))
(run-hooks 'print-diary-entries-hook)) (run-hooks 'print-diary-entries-hook))
(let ((diary-buffer (let ((diary-buffer
(find-buffer-visiting (substitute-in-file-name diary-file)))) (find-buffer-visiting (substitute-in-file-name diary-file))))
(if diary-buffer (if diary-buffer
(let ((temp-buffer (get-buffer-create "*Printable Diary Entries*")) (let ((temp-buffer (get-buffer-create " *Printable Diary Entries*"))
(heading)) (heading))
(save-excursion (with-current-buffer diary-buffer
(set-buffer diary-buffer)
(setq heading (setq heading
(if (not (stringp mode-line-format)) (if (not (stringp mode-line-format))
"All Diary Entries" "All Diary Entries"
(string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format) (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
(substring mode-line-format (match-string 1 mode-line-format)))
(match-beginning 1) (match-end 1)))) (let ((start (point-min))
(copy-to-buffer temp-buffer (point-min) (point-max)) end)
(while
(progn
(setq end (next-single-char-property-change
start 'invisible))
(if (get-char-property start 'invisible)
nil
(with-current-buffer temp-buffer
(insert-buffer-substring diary-buffer
start (or end (point-max)))))
(setq start end)
(and end (< end (point-max))))))
(set-buffer temp-buffer) (set-buffer temp-buffer)
(while (re-search-forward "\^M.*$" nil t)
(replace-match ""))
(goto-char (point-min)) (goto-char (point-min))
(insert heading "\n" (insert heading "\n"
(make-string (length heading) ?=) "\n") (make-string (length heading) ?=) "\n")
@ -764,18 +763,19 @@ is created."
(pop-up-frames (window-dedicated-p (selected-window)))) (pop-up-frames (window-dedicated-p (selected-window))))
(with-current-buffer (or (find-buffer-visiting d-file) (with-current-buffer (or (find-buffer-visiting d-file)
(find-file-noselect d-file t)) (find-file-noselect d-file t))
(when (eq major-mode 'fundamental-mode) (diary-mode))
(diary-unhide-everything) (diary-unhide-everything)
(display-buffer (current-buffer))))) (display-buffer (current-buffer)))))
(defcustom diary-mail-addr (defcustom diary-mail-addr
(if (boundp 'user-mail-address) user-mail-address "") (if (boundp 'user-mail-address) user-mail-address "")
"*Email address that `diary-mail-entries' will send email to." "Email address that `diary-mail-entries' will send email to."
:group 'diary :group 'diary
:type 'string :type 'string
:version "20.3") :version "20.3")
(defcustom diary-mail-days 7 (defcustom diary-mail-days 7
"*Default number of days for `diary-mail-entries' to check." "Default number of days for `diary-mail-entries' to check."
:group 'diary :group 'diary
:type 'integer :type 'integer
:version "20.3") :version "20.3")
@ -866,6 +866,7 @@ diary entries."
file-glob-attrs marks) file-glob-attrs marks)
(with-current-buffer (find-file-noselect (diary-check-diary-file) t) (with-current-buffer (find-file-noselect (diary-check-diary-file) t)
(save-excursion (save-excursion
(when (eq major-mode 'fundamental-mode) (diary-mode))
(setq mark-diary-entries-in-calendar t) (setq mark-diary-entries-in-calendar t)
(message "Marking diary entries...") (message "Marking diary entries...")
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
@ -1118,7 +1119,7 @@ A value of 0 in any position of the pattern is a wildcard."
(defcustom diary-unknown-time (defcustom diary-unknown-time
-9999 -9999
"*Value returned by diary-entry-time when no time is found. "Value returned by diary-entry-time when no time is found.
The default value -9999 causes entries with no recognizable time to be placed The default value -9999 causes entries with no recognizable time to be placed
before those with times; 9999 would place entries with no recognizable time before those with times; 9999 would place entries with no recognizable time
after those with times." after those with times."
@ -1361,7 +1362,7 @@ best if they are nonmarking."
diary-entry)) diary-entry))
(if diary-entry (if diary-entry
(progn (progn
(subst-char-in-region line-start (point) ?\^M ?\n t) (remove-overlays line-start (point) 'invisible 'diary)
(if (< 0 (length entry)) (if (< 0 (length entry))
(setq temp (diary-pull-attrs entry file-glob-attrs) (setq temp (diary-pull-attrs entry file-glob-attrs)
entry (nth 0 temp) entry (nth 0 temp)
@ -1511,7 +1512,7 @@ highlighting the day in the calendar."
(cons mark entry))))) (cons mark entry)))))
(defun diary-anniversary (month day year &optional mark) (defun diary-anniversary (month day &optional year mark)
"Anniversary diary entry. "Anniversary diary entry.
Entry applies if date is the anniversary of MONTH, DAY, YEAR if Entry applies if date is the anniversary of MONTH, DAY, YEAR if
`european-calendar-style' is nil, and DAY, MONTH, YEAR if `european-calendar-style' is nil, and DAY, MONTH, YEAR if
@ -1530,7 +1531,7 @@ use when highlighting the day in the calendar."
day day
month)) month))
(y (extract-calendar-year date)) (y (extract-calendar-year date))
(diff (- y year))) (diff (if year (- y year) 100)))
(if (and (= m 2) (= d 29) (not (calendar-leap-year-p y))) (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y)))
(setq m 3 (setq m 3
d 1)) d 1))
@ -1578,7 +1579,7 @@ use when highlighting the day in the calendar."
(concat (int-to-string days) (if (= 1 days) " day" " days"))) (concat (int-to-string days) (if (= 1 days) " day" " days")))
" until " " until "
diary-entry) diary-entry)
"*Pseudo-pattern giving form of reminder messages in the fancy diary "Pseudo-pattern giving form of reminder messages in the fancy diary
display. display.
Used by the function `diary-remind', a pseudo-pattern is a list of Used by the function `diary-remind', a pseudo-pattern is a list of
@ -1657,12 +1658,10 @@ Do nothing if DATE or STRING is nil."
(defun make-diary-entry (string &optional nonmarking file) (defun make-diary-entry (string &optional nonmarking file)
"Insert a diary entry STRING which may be NONMARKING in FILE. "Insert a diary entry STRING which may be NONMARKING in FILE.
If omitted, NONMARKING defaults to nil and FILE defaults to If omitted, NONMARKING defaults to nil and FILE defaults to
`diary-file'. Adds `diary-redraw-calendar' to `diary-file'."
`write-contents-functions' for FILE, so that the calendar will be
redrawn with the new entry marked, if necessary."
(let ((pop-up-frames (window-dedicated-p (selected-window)))) (let ((pop-up-frames (window-dedicated-p (selected-window))))
(find-file-other-window (substitute-in-file-name (or file diary-file)))) (find-file-other-window (substitute-in-file-name (or file diary-file))))
(add-hook 'after-save-hook 'diary-redraw-calendar nil t) (when (eq major-mode 'fundamental-mode) (diary-mode))
(widen) (widen)
(diary-unhide-everything) (diary-unhide-everything)
(goto-char (point-max)) (goto-char (point-max))
@ -1867,6 +1866,13 @@ names."
(eval-when-compile (require 'cal-hebrew) (eval-when-compile (require 'cal-hebrew)
(require 'cal-islam)) (require 'cal-islam))
(defconst diary-time-regexp
;; Formats that should be accepted:
;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am
(concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
"[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
"\\)\\([AaPp][Mm]\\)?\\)"))
(defvar diary-font-lock-keywords (defvar diary-font-lock-keywords
(append (append
(diary-font-lock-date-forms calendar-month-name-array (diary-font-lock-date-forms calendar-month-name-array
@ -1907,8 +1913,10 @@ names."
"?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
'(1 font-lock-reference-face)) '(1 font-lock-reference-face))
'(diary-font-lock-sexps . font-lock-keyword-face) '(diary-font-lock-sexps . font-lock-keyword-face)
'("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?" (cons
. font-lock-function-name-face))) (concat ;; "^[ \t]+"
diary-time-regexp "\\(-" diary-time-regexp "\\)?")
'font-lock-function-name-face)))
"Forms to highlight in `diary-mode'.") "Forms to highlight in `diary-mode'.")

View file

@ -91,6 +91,7 @@ and type 3 is the list (HIGH LOW MICRO)."
((eq type 1) (list high low)) ((eq type 1) (list high low))
((eq type 2) (list high low micro)))) ((eq type 2) (list high low micro))))
(autoload 'parse-time-string "parse-time")
(autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'timezone-make-date-arpa-standard "timezone")
;;;###autoload ;;;###autoload

View file

@ -3109,8 +3109,8 @@ When redirection is completed, the process filter is restored to
this value.") this value.")
(defvar comint-redirect-subvert-readonly nil (defvar comint-redirect-subvert-readonly nil
"Non-nil means comint-redirect can insert into otherwise-readonly buffers. "Non-nil means `comint-redirect' can insert into read-only buffers.
The readonly status is toggled around insertion. This works by binding `inhibit-read-only' around the insertion.
This is useful, for instance, for insertion into Help mode buffers. This is useful, for instance, for insertion into Help mode buffers.
You probably want to set it locally to the output buffer.") You probably want to set it locally to the output buffer.")

1073
lisp/dframe.el Normal file

File diff suppressed because it is too large Load diff

View file

@ -103,11 +103,15 @@ Buffer B."
) )
(make-variable-buffer-local 'ediff-skip-merge-regions-that-differ-from-default) (make-variable-buffer-local 'ediff-skip-merge-regions-that-differ-from-default)
;; check if there is no clash between the ancestor and one of the variants.
(defsubst ediff-merge-region-is-non-clash (n)
(string-match "prefer" (or (ediff-get-state-of-merge n) "")))
;; If ediff-show-clashes-only, check if there is no clash between the ancestor ;; If ediff-show-clashes-only, check if there is no clash between the ancestor
;; and one of the variants. ;; and one of the variants.
(defsubst ediff-merge-region-is-non-clash (n) (defsubst ediff-merge-region-is-non-clash-to-skip (n)
(and ediff-show-clashes-only (and ediff-show-clashes-only
(string-match "prefer" (or (ediff-get-state-of-merge n) "")))) (ediff-merge-region-is-non-clash n)))
;; If ediff-skip-changed-regions, check if the merge region differs from ;; If ediff-skip-changed-regions, check if the merge region differs from
;; the current default. If a region is different from the default, it means ;; the current default. If a region is different from the default, it means

View file

@ -1624,7 +1624,7 @@ Useful commands:
(save-excursion (save-excursion
(set-buffer meta-diff-buff) (set-buffer meta-diff-buff)
(goto-char (point-max)) (goto-char (point-max))
(insert-buffer custom-diff-buf) (insert-buffer-substring custom-diff-buf)
(insert "\n"))) (insert "\n")))
;; if ediff session is not live, run diff directly on the files ;; if ediff session is not live, run diff directly on the files
((memq metajob '(ediff-directories ((memq metajob '(ediff-directories
@ -1643,7 +1643,7 @@ Useful commands:
(save-excursion (save-excursion
(set-buffer meta-diff-buff) (set-buffer meta-diff-buff)
(goto-char (point-max)) (goto-char (point-max))
(insert-buffer tmp-buf) (insert-buffer-substring tmp-buf)
(insert "\n"))) (insert "\n")))
(t (t
(ediff-kill-buffer-carefully meta-diff-buff) (ediff-kill-buffer-carefully meta-diff-buff)
@ -1691,7 +1691,8 @@ all marked sessions must be active."
(ediff-get-session-objC-name info))) (ediff-get-session-objC-name info)))
(set-buffer (get-buffer-create ediff-tmp-buffer)) (set-buffer (get-buffer-create ediff-tmp-buffer))
(erase-buffer) (erase-buffer)
(insert-buffer patchbuffer) (insert-buffer-substring patchbuffer)
(goto-char (point-min))
(display-buffer ediff-tmp-buffer 'not-this-window) (display-buffer ediff-tmp-buffer 'not-this-window)
)) ))
(error "The patch buffer wasn't found")))) (error "The patch buffer wasn't found"))))

View file

@ -297,16 +297,23 @@ program."
;; (file1 . file2). Get it using ediff-get-session-objA. ;; (file1 . file2). Get it using ediff-get-session-objA.
(ediff-get-session-objA-name session-info)) (ediff-get-session-objA-name session-info))
;; base-dir1 is the dir part of the 1st file in the patch ;; base-dir1 is the dir part of the 1st file in the patch
(base-dir1 (file-name-directory (car proposed-file-names))) (base-dir1
(or (file-name-directory (car proposed-file-names))
""))
;; directory part of the 2nd file in the patch ;; directory part of the 2nd file in the patch
(base-dir2 (file-name-directory (cdr proposed-file-names))) (base-dir2
(or (file-name-directory (cdr proposed-file-names))
""))
) )
;; If both base-dir1 and base-dir2 are relative, assume that ;; If both base-dir1 and base-dir2 are relative and exist,
;; assume that
;; these dirs lead to the actual files starting at the present ;; these dirs lead to the actual files starting at the present
;; directory. So, we don't strip these relative dirs from the ;; directory. So, we don't strip these relative dirs from the
;; file names. This is a heuristic intended to improve guessing ;; file names. This is a heuristic intended to improve guessing
(unless (or (file-name-absolute-p base-dir1) (unless (or (file-name-absolute-p base-dir1)
(file-name-absolute-p base-dir2)) (file-name-absolute-p base-dir2)
(not (file-exists-p base-dir1))
(not (file-exists-p base-dir2)))
(setq base-dir1 "" (setq base-dir1 ""
base-dir2 "")) base-dir2 ""))
(or (string= (car proposed-file-names) "/dev/null") (or (string= (car proposed-file-names) "/dev/null")
@ -377,8 +384,8 @@ other files, enter /dev/null
(concat actual-dir (cdr proposed-file-names))))) (concat actual-dir (cdr proposed-file-names)))))
)) ))
ediff-patch-map) ediff-patch-map)
;; check for the shorter existing file in each pair and discard the other ;; Check for the existing files in each pair and discard the nonexisting
;; one ;; ones. If both exist, ask the user.
(mapcar (lambda (session-info) (mapcar (lambda (session-info)
(let* ((file1 (car (ediff-get-session-objA-name session-info))) (let* ((file1 (car (ediff-get-session-objA-name session-info)))
(file2 (cdr (ediff-get-session-objA-name session-info))) (file2 (cdr (ediff-get-session-objA-name session-info)))

View file

@ -329,7 +329,7 @@ to invocation.")
ediff-word-mode-job (ediff-word-mode-job)) ediff-word-mode-job (ediff-word-mode-job))
;; Don't delete variants in case of ediff-buffer-* jobs without asking. ;; Don't delete variants in case of ediff-buffer-* jobs without asking.
;; This is because u may loose work---dangerous. ;; This is because one may loose work---dangerous.
(if (string-match "buffer" (symbol-name ediff-job-name)) (if (string-match "buffer" (symbol-name ediff-job-name))
(setq ediff-keep-variants t)) (setq ediff-keep-variants t))
@ -368,6 +368,7 @@ to invocation.")
(save-excursion (save-excursion
(set-buffer buffer-C) (set-buffer buffer-C)
(insert-buffer-substring buf) (insert-buffer-substring buf)
(goto-char (point-min))
(funcall (ediff-with-current-buffer buf major-mode)) (funcall (ediff-with-current-buffer buf major-mode))
(widen) ; merge buffer is always widened (widen) ; merge buffer is always widened
(add-hook 'local-write-file-hooks 'ediff-set-merge-mode nil t) (add-hook 'local-write-file-hooks 'ediff-set-merge-mode nil t)
@ -1729,7 +1730,7 @@ With a prefix argument, go forward that many differences."
(or (>= n ediff-number-of-differences) (or (>= n ediff-number-of-differences)
(setq regexp-skip (funcall ediff-skip-diff-region-function n)) (setq regexp-skip (funcall ediff-skip-diff-region-function n))
;; this won't exec if regexp-skip is t ;; this won't exec if regexp-skip is t
(setq non-clash-skip (ediff-merge-region-is-non-clash n) (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n)
skip-changed skip-changed
(ediff-skip-merge-region-if-changed-from-default-p n)) (ediff-skip-merge-region-if-changed-from-default-p n))
(ediff-install-fine-diff-if-necessary n)) (ediff-install-fine-diff-if-necessary n))
@ -1744,6 +1745,7 @@ With a prefix argument, go forward that many differences."
skip-changed skip-changed
;; skip difference regions that differ in white space ;; skip difference regions that differ in white space
(and ediff-ignore-similar-regions (and ediff-ignore-similar-regions
(ediff-merge-region-is-non-clash n)
(or (eq (ediff-no-fine-diffs-p n) t) (or (eq (ediff-no-fine-diffs-p n) t)
(and (ediff-merge-job) (and (ediff-merge-job)
(eq (ediff-no-fine-diffs-p n) 'C))) (eq (ediff-no-fine-diffs-p n) 'C)))
@ -1754,7 +1756,7 @@ With a prefix argument, go forward that many differences."
(or (>= n ediff-number-of-differences) (or (>= n ediff-number-of-differences)
(setq regexp-skip (funcall ediff-skip-diff-region-function n)) (setq regexp-skip (funcall ediff-skip-diff-region-function n))
;; this won't exec if regexp-skip is t ;; this won't exec if regexp-skip is t
(setq non-clash-skip (ediff-merge-region-is-non-clash n) (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n)
skip-changed skip-changed
(ediff-skip-merge-region-if-changed-from-default-p n)) (ediff-skip-merge-region-if-changed-from-default-p n))
(ediff-install-fine-diff-if-necessary n)) (ediff-install-fine-diff-if-necessary n))
@ -1778,7 +1780,7 @@ With a prefix argument, go back that many differences."
(or (< n 0) (or (< n 0)
(setq regexp-skip (funcall ediff-skip-diff-region-function n)) (setq regexp-skip (funcall ediff-skip-diff-region-function n))
;; this won't exec if regexp-skip is t ;; this won't exec if regexp-skip is t
(setq non-clash-skip (ediff-merge-region-is-non-clash n) (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n)
skip-changed skip-changed
(ediff-skip-merge-region-if-changed-from-default-p n)) (ediff-skip-merge-region-if-changed-from-default-p n))
(ediff-install-fine-diff-if-necessary n)) (ediff-install-fine-diff-if-necessary n))
@ -1802,7 +1804,7 @@ With a prefix argument, go back that many differences."
(or (< n 0) (or (< n 0)
(setq regexp-skip (funcall ediff-skip-diff-region-function n)) (setq regexp-skip (funcall ediff-skip-diff-region-function n))
;; this won't exec if regexp-skip is t ;; this won't exec if regexp-skip is t
(setq non-clash-skip (ediff-merge-region-is-non-clash n) (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n)
skip-changed skip-changed
(ediff-skip-merge-region-if-changed-from-default-p n)) (ediff-skip-merge-region-if-changed-from-default-p n))
(ediff-install-fine-diff-if-necessary n)) (ediff-install-fine-diff-if-necessary n))

View file

@ -900,7 +900,7 @@ into icons, regardless of the window manager."
(ediff-with-current-buffer ctl-buffer (ediff-with-current-buffer ctl-buffer
(ediff-cond-compile-for-xemacs-or-emacs (ediff-cond-compile-for-xemacs-or-emacs
(set-buffer-menubar nil) ; xemacs (when (featurep 'menubar) (set-buffer-menubar nil)) ; xemacs
nil ; emacs nil ; emacs
) )
;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse)) ;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse))
@ -1054,7 +1054,8 @@ into icons, regardless of the window manager."
(if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame))
(let ((ctl-frame ediff-control-frame)) (let ((ctl-frame ediff-control-frame))
(ediff-cond-compile-for-xemacs-or-emacs (ediff-cond-compile-for-xemacs-or-emacs
(set-buffer-menubar default-menubar) ; xemacs (when (featurep 'menubar)
(set-buffer-menubar default-menubar)) ; xemacs
nil ; emacs nil ; emacs
) )
(setq ediff-control-frame nil) (setq ediff-control-frame nil)

View file

@ -8,7 +8,7 @@
;; Keywords: comparing, merging, patching, tools, unix ;; Keywords: comparing, merging, patching, tools, unix
(defconst ediff-version "2.80.1" "The current version of Ediff") (defconst ediff-version "2.80.1" "The current version of Ediff")
(defconst ediff-date "September 19, 2005" "Date of last update") (defconst ediff-date "October 5, 2005" "Date of last update")
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.

View file

@ -103,37 +103,37 @@ truncated to make more of the arglist or documentation string visible."
;;; No user options below here. ;;; No user options below here.
;; Commands after which it is appropriate to print in the echo area. (defvar eldoc-message-commands-table-size 31
;; Eldoc does not try to print function arglists, etc. after just any command, "This is used by eldoc-add-command to initialize eldoc-message-commands
;; because some commands print their own messages in the echo area and these as an obarray.
;; functions would instantly overwrite them. But self-insert-command as well It should probably never be necessary to do so, but if you
;; as most motion commands are good candidates. choose to increase the number of buckets, you must do so before loading
;; This variable contains an obarray of symbols; do not manipulate it this file since the obarray is initialized at load time.
;; directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'. Remember to keep it a prime number to improve hash performance.")
(defvar eldoc-message-commands nil)
;; This is used by eldoc-add-command to initialize eldoc-message-commands (defconst eldoc-message-commands
;; as an obarray. (make-vector eldoc-message-commands-table-size 0)
;; It should probably never be necessary to do so, but if you "Commands after which it is appropriate to print in the echo area.
;; choose to increase the number of buckets, you must do so before loading Eldoc does not try to print function arglists, etc. after just any command,
;; this file since the obarray is initialized at load time. because some commands print their own messages in the echo area and these
;; Remember to keep it a prime number to improve hash performance. functions would instantly overwrite them. But self-insert-command as well
(defvar eldoc-message-commands-table-size 31) as most motion commands are good candidates.
This variable contains an obarray of symbols; do not manipulate it
directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
;; Bookkeeping; elements are as follows: (defconst eldoc-last-data (make-vector 3 nil)
;; 0 - contains the last symbol read from the buffer. "Bookkeeping; elements are as follows:
;; 1 - contains the string last displayed in the echo area for that 0 - contains the last symbol read from the buffer.
;; symbol, so it can be printed again if necessary without reconsing. 1 - contains the string last displayed in the echo area for that
;; 2 - 'function if function args, 'variable if variable documentation. symbol, so it can be printed again if necessary without reconsing.
(defvar eldoc-last-data (make-vector 3 nil)) 2 - 'function if function args, 'variable if variable documentation.")
(defvar eldoc-last-message nil) (defvar eldoc-last-message nil)
;; eldoc's timer object. (defvar eldoc-timer nil "eldoc's timer object.")
(defvar eldoc-timer nil)
;; idle time delay currently in use by timer. (defvar eldoc-current-idle-delay eldoc-idle-delay
;; This is used to determine if eldoc-idle-delay is changed by the user. "idle time delay currently in use by timer.
(defvar eldoc-current-idle-delay eldoc-idle-delay) This is used to determine if `eldoc-idle-delay' is changed by the user.")
;;;###autoload ;;;###autoload
@ -408,53 +408,32 @@ Emacs Lisp mode) that support Eldoc.")
;; These functions do display-command table management. ;; These functions do display-command table management.
(defun eldoc-add-command (&rest cmds) (defun eldoc-add-command (&rest cmds)
(or eldoc-message-commands (dolist (name cmds)
(setq eldoc-message-commands (and (symbolp name)
(make-vector eldoc-message-commands-table-size 0))) (setq name (symbol-name name)))
(set (intern name eldoc-message-commands) t)))
(let (name sym)
(while cmds
(setq name (car cmds))
(setq cmds (cdr cmds))
(cond ((symbolp name)
(setq sym name)
(setq name (symbol-name sym)))
((stringp name)
(setq sym (intern-soft name))))
(and (symbolp sym)
(fboundp sym)
(set (intern name eldoc-message-commands) t)))))
(defun eldoc-add-command-completions (&rest names) (defun eldoc-add-command-completions (&rest names)
(while names (dolist (name names)
(apply 'eldoc-add-command (apply 'eldoc-add-command (all-completions name obarray 'commandp))))
(all-completions (car names) obarray 'fboundp))
(setq names (cdr names))))
(defun eldoc-remove-command (&rest cmds) (defun eldoc-remove-command (&rest cmds)
(let (name) (dolist (name cmds)
(while cmds (and (symbolp name)
(setq name (car cmds)) (setq name (symbol-name name)))
(setq cmds (cdr cmds)) (unintern name eldoc-message-commands)))
(and (symbolp name)
(setq name (symbol-name name)))
(unintern name eldoc-message-commands))))
(defun eldoc-remove-command-completions (&rest names) (defun eldoc-remove-command-completions (&rest names)
(while names (dolist (name names)
(apply 'eldoc-remove-command (apply 'eldoc-remove-command
(all-completions (car names) eldoc-message-commands)) (all-completions name eldoc-message-commands))))
(setq names (cdr names))))
;; Prime the command list. ;; Prime the command list.
(eldoc-add-command-completions (eldoc-add-command-completions
"backward-" "beginning-of-" "delete-other-windows" "delete-window" "backward-" "beginning-of-" "move-beginning-of-" "delete-other-windows"
"end-of-" "exchange-point-and-mark" "forward-" "delete-window"
"end-of-" "move-end-of-" "exchange-point-and-mark" "forward-"
"indent-for-tab-command" "goto-" "mark-page" "mark-paragraph" "indent-for-tab-command" "goto-" "mark-page" "mark-paragraph"
"mouse-set-point" "move-" "pop-global-mark" "next-" "other-window" "mouse-set-point" "move-" "pop-global-mark" "next-" "other-window"
"previous-" "recenter" "scroll-" "self-insert-command" "previous-" "recenter" "scroll-" "self-insert-command"
@ -462,5 +441,5 @@ Emacs Lisp mode) that support Eldoc.")
(provide 'eldoc) (provide 'eldoc)
;;; arch-tag: c9a58f9d-2055-46c1-9b82-7248b71a8375 ;; arch-tag: c9a58f9d-2055-46c1-9b82-7248b71a8375
;;; eldoc.el ends here ;;; eldoc.el ends here

View file

@ -59,9 +59,9 @@
(modify-syntax-entry ?\t " " table) (modify-syntax-entry ?\t " " table)
(modify-syntax-entry ?\f " " table) (modify-syntax-entry ?\f " " table)
(modify-syntax-entry ?\n "> " table) (modify-syntax-entry ?\n "> " table)
;;; This is probably obsolete since nowadays such features use overlays. ;; This is probably obsolete since nowadays such features use overlays.
;;; ;; Give CR the same syntax as newline, for selective-display. ;; ;; Give CR the same syntax as newline, for selective-display.
;;; (modify-syntax-entry ?\^m "> " table) ;; (modify-syntax-entry ?\^m "> " table)
(modify-syntax-entry ?\; "< " table) (modify-syntax-entry ?\; "< " table)
(modify-syntax-entry ?` "' " table) (modify-syntax-entry ?` "' " table)
(modify-syntax-entry ?' "' " table) (modify-syntax-entry ?' "' " table)
@ -82,8 +82,8 @@
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
(modify-syntax-entry ?\[ "_ " table) (modify-syntax-entry ?\[ "_ " table)
(modify-syntax-entry ?\] "_ " table) (modify-syntax-entry ?\] "_ " table)
(modify-syntax-entry ?# "' 14bn" table) (modify-syntax-entry ?# "' 14b" table)
(modify-syntax-entry ?| "\" 23b" table) (modify-syntax-entry ?| "\" 23bn" table)
table)) table))
(define-abbrev-table 'lisp-mode-abbrev-table ()) (define-abbrev-table 'lisp-mode-abbrev-table ())
@ -147,25 +147,45 @@
(put 'define-ibuffer-filter 'doc-string-elt 2) (put 'define-ibuffer-filter 'doc-string-elt 2)
(put 'define-ibuffer-op 'doc-string-elt 3) (put 'define-ibuffer-op 'doc-string-elt 3)
(put 'define-ibuffer-sorter 'doc-string-elt 2) (put 'define-ibuffer-sorter 'doc-string-elt 2)
(put 'lambda 'doc-string-elt 2)
(defvar lisp-doc-string-elt-property 'doc-string-elt
"The symbol property that holds the docstring position info.")
(defun lisp-font-lock-syntactic-face-function (state) (defun lisp-font-lock-syntactic-face-function (state)
(if (nth 3 state) (if (nth 3 state)
(if (and (eq (nth 0 state) 1) ;; This might be a (doc)string or a |...| symbol.
;; This might be a docstring. (let ((startpos (nth 8 state)))
(save-excursion (if (eq (char-after startpos) ?|)
(let ((n 0)) ;; This is not a string, but a |...| symbol.
(goto-char (nth 8 state)) nil
(condition-case nil (let* ((listbeg (nth 1 state))
(while (and (not (bobp)) (firstsym (and listbeg
(progn (backward-sexp 1) (setq n (1+ n))))) (save-excursion
(scan-error nil)) (goto-char listbeg)
(when (> n 0) (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
(let ((sym (intern-soft (match-string 1)))))
(buffer-substring (docelt (and firstsym (get (intern-soft firstsym)
(point) (progn (forward-sexp 1) (point)))))) lisp-doc-string-elt-property))))
(eq n (or (get sym 'doc-string-elt) 3))))))) (if (and docelt
font-lock-doc-face ;; It's a string in a form that can have a docstring.
font-lock-string-face) ;; Check whether it's in docstring position.
(save-excursion
(when (functionp docelt)
(goto-char (match-end 1))
(setq docelt (funcall docelt)))
(goto-char listbeg)
(forward-char 1)
(condition-case nil
(while (and (> docelt 0) (< (point) startpos)
(progn (forward-sexp 1) t))
(setq docelt (1- docelt)))
(error nil))
(and (zerop docelt) (<= (point) startpos)
(progn (forward-comment (point-max)) t)
(= (point) (nth 8 state)))))
font-lock-doc-face
font-lock-string-face))))
font-lock-comment-face)) font-lock-comment-face))
;; The LISP-SYNTAX argument is used by code in inf-lisp.el and is ;; The LISP-SYNTAX argument is used by code in inf-lisp.el and is

View file

@ -494,13 +494,20 @@
viper-empty-keymap)) viper-empty-keymap))
)) ))
;; in emacs with emulation-mode-map-alists, nothing needs to be done ;; This var is not local in Emacs, so we make it local. It must be local
;; because although the stack of minor modes can be the same for all buffers,
;; the associated *keymaps* can be different. In Viper,
;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have
;; different keymaps for different buffers. Also, the keymaps associated
;; with viper-vi/insert-state-modifier-minor-mode can be different.
;; ***This is needed only in case emulation-mode-map-alists is not defined.
;; In emacs with emulation-mode-map-alists, nothing needs to be done
(unless (unless
(and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
(setq minor-mode-map-alist (set (make-local-variable 'minor-mode-map-alist)
(viper-append-filter-alist (viper-append-filter-alist
(append viper--intercept-key-maps viper--key-maps) (append viper--intercept-key-maps viper--key-maps)
minor-mode-map-alist))) minor-mode-map-alist)))
) )
@ -509,7 +516,7 @@
;; Modifies mode-line-buffer-identification. ;; Modifies mode-line-buffer-identification.
(defun viper-refresh-mode-line () (defun viper-refresh-mode-line ()
(setq viper-mode-string (set (make-local-variable 'viper-mode-string)
(cond ((eq viper-current-state 'emacs-state) viper-emacs-state-id) (cond ((eq viper-current-state 'emacs-state) viper-emacs-state-id)
((eq viper-current-state 'vi-state) viper-vi-state-id) ((eq viper-current-state 'vi-state) viper-vi-state-id)
((eq viper-current-state 'replace-state) viper-replace-state-id) ((eq viper-current-state 'replace-state) viper-replace-state-id)
@ -4781,7 +4788,7 @@ sensitive for VI-style look-and-feel."
level-changed t) level-changed t)
(insert " (insert "
Please specify your level of familiarity with the venomous VI PERil Please specify your level of familiarity with the venomous VI PERil
(and the VI Plan for Emacs Rescue). \(and the VI Plan for Emacs Rescue).
You can change it at any time by typing `M-x viper-set-expert-level RET' You can change it at any time by typing `M-x viper-set-expert-level RET'
1 -- BEGINNER: Almost all Emacs features are suppressed. 1 -- BEGINNER: Almost all Emacs features are suppressed.
@ -5000,5 +5007,5 @@ Mail anyway (y or n)? ")
;;; arch-tag: 739a6450-5fda-44d0-88b0-325053d888c2 ;; arch-tag: 739a6450-5fda-44d0-88b0-325053d888c2
;;; viper-cmd.el ends here ;;; viper-cmd.el ends here

View file

@ -115,11 +115,6 @@ In all likelihood, you don't need to bother with this setting."
;;; Macros ;;; Macros
;; Fool the compiler to avoid warnings.
;; Viper calls make-variable-buffer-local from within other functions, which
;; triggers compiler warnings.
(defalias 'viper-make-variable-buffer-local 'make-variable-buffer-local)
(defmacro viper-deflocalvar (var default-value &optional documentation) (defmacro viper-deflocalvar (var default-value &optional documentation)
`(progn `(progn
(defvar ,var ,default-value (defvar ,var ,default-value
@ -1019,19 +1014,19 @@ Should be set in `~/.viper' file."
(defun viper-restore-cursor-type () (defun viper-restore-cursor-type ()
(condition-case nil (condition-case nil
(if viper-xemacs-p (if viper-xemacs-p
(setq bar-cursor nil) (set (make-local-variable 'bar-cursor) nil)
(setq cursor-type default-cursor-type)) (setq cursor-type default-cursor-type))
(error nil))) (error nil)))
(defun viper-set-insert-cursor-type () (defun viper-set-insert-cursor-type ()
(if viper-xemacs-p (if viper-xemacs-p
(setq bar-cursor 2) (set (make-local-variable 'bar-cursor) 2)
(setq cursor-type '(bar . 2)))) (setq cursor-type '(bar . 2))))
;;; Local Variables: ;; Local Variables:
;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) ;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
;;; End: ;; End:
;;; arch-tag: 4efa2416-1fcb-4690-be10-1a2a0248d250 ;; arch-tag: 4efa2416-1fcb-4690-be10-1a2a0248d250
;;; viper-init.el ends here ;;; viper-init.el ends here

View file

@ -9,7 +9,7 @@
;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Keywords: emulations ;; Keywords: emulations
(defconst viper-version "3.11.5 of September 19, 2005" (defconst viper-version "3.11.5 of October 5, 2005"
"The current version of Viper") "The current version of Viper")
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -605,8 +605,6 @@ This startup message appears whenever you load Viper, unless you type `y' now."
)) ))
(viper-set-expert-level 'dont-change-unless))) (viper-set-expert-level 'dont-change-unless)))
(if viper-xemacs-p
(viper-make-variable-buffer-local 'bar-cursor))
(if (eq major-mode 'viper-mode) (if (eq major-mode 'viper-mode)
(setq major-mode 'fundamental-mode)) (setq major-mode 'fundamental-mode))
@ -627,8 +625,8 @@ This startup message appears whenever you load Viper, unless you type `y' now."
;; This hook designed to enable Vi-style editing in comint-based modes." ;; This hook designed to enable Vi-style editing in comint-based modes."
(defun viper-comint-mode-hook () (defun viper-comint-mode-hook ()
(setq require-final-newline nil (set (make-local-variable 'require-final-newline) nil)
viper-ex-style-editing nil (setq viper-ex-style-editing nil
viper-ex-style-motion nil) viper-ex-style-motion nil)
(viper-change-state-to-insert)) (viper-change-state-to-insert))
@ -1000,17 +998,6 @@ It also can't undo some Viper settings."
;; these are primarily advices and Vi-ish variable settings ;; these are primarily advices and Vi-ish variable settings
(defun viper-non-hook-settings () (defun viper-non-hook-settings ()
;; This var is not local in Emacs, so we make it local. It must be local
;; because although the stack of minor modes can be the same for all buffers,
;; the associated *keymaps* can be different. In Viper,
;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have
;; different keymaps for different buffers. Also, the keymaps associated
;; with viper-vi/insert-state-modifier-minor-mode can be different.
;; ***This is needed only in case emulation-mode-map-alists is not defined
(unless
(and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
(viper-make-variable-buffer-local 'minor-mode-map-alist))
;; Viper changes the default mode-line-buffer-identification ;; Viper changes the default mode-line-buffer-identification
(setq-default mode-line-buffer-identification '(" %b")) (setq-default mode-line-buffer-identification '(" %b"))
@ -1018,8 +1005,6 @@ It also can't undo some Viper settings."
(setq next-line-add-newlines nil (setq next-line-add-newlines nil
require-final-newline t) require-final-newline t)
(viper-make-variable-buffer-local 'require-final-newline)
;; don't bark when mark is inactive ;; don't bark when mark is inactive
(if viper-emacs-p (if viper-emacs-p
(setq mark-even-if-inactive t)) (setq mark-even-if-inactive t))
@ -1027,7 +1012,6 @@ It also can't undo some Viper settings."
(setq scroll-step 1) (setq scroll-step 1)
;; Variable displaying the current Viper state in the mode line. ;; Variable displaying the current Viper state in the mode line.
(viper-deflocalvar viper-mode-string viper-emacs-state-id)
(or (memq 'viper-mode-string global-mode-string) (or (memq 'viper-mode-string global-mode-string)
(setq global-mode-string (setq global-mode-string
(append '("" viper-mode-string) (cdr global-mode-string)))) (append '("" viper-mode-string) (cdr global-mode-string))))
@ -1336,9 +1320,9 @@ These two lines must come in the order given.
(provide 'viper) (provide 'viper)
;;; Local Variables: ;; Local Variables:
;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) ;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
;;; End: ;; End:
;;; arch-tag: 5f3e844c-c4e6-4bbd-9b73-63bdc14e7d79 ;; arch-tag: 5f3e844c-c4e6-4bbd-9b73-63bdc14e7d79
;;; viper.el ends here ;;; viper.el ends here

371
lisp/ezimage.el Normal file
View file

@ -0,0 +1,371 @@
;;; ezimage --- Generalized Image management
;;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; A few routines for placing an image over text that will work for any
;; Emacs implementation without error. When images are not supported, then
;; they are justnot displayed.
;;
;; The idea is that gui buffers (trees, buttons, etc) will have text
;; representations of the GUI elements. These routines will replace the text
;; with an image when images are available.
;;
;; This file requires the `image' package if it is available.
(condition-case nil
(require 'image)
(error nil))
;;; Code:
(defcustom ezimage-use-images
(and (or (fboundp 'defimage) ; emacs 21
(fboundp 'make-image-specifier)) ; xemacs
(if (fboundp 'display-graphic-p) ; emacs 21
(display-graphic-p)
window-system) ; old emacs & xemacs
(or (not (fboundp 'image-type-available-p)) ; xemacs?
(image-type-available-p 'xpm))) ; emacs 21
"*Non-nil if ezimage should display icons."
:group 'ezimage
:version "21.1"
:type 'boolean)
;;; Create our own version of defimage
(eval-and-compile
(if (fboundp 'defimage)
(progn
(defmacro defezimage (variable imagespec docstring)
"Define VARIABLE as an image if `defimage' is not available.
IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
`(progn
(defimage ,variable ,imagespec ,docstring)
(put (quote ,variable) 'ezimage t)))
; (defalias 'defezimage 'defimage)
;; This hack is for the ezimage install which has an icons direcory for
;; the default icons to be used.
;; (add-to-list 'load-path
;; (concat (file-name-directory
;; (locate-library "ezimage.el"))
;; "icons"))
)
(if (not (fboundp 'make-glyph))
(defmacro defezimage (variable imagespec docstring)
"Don't bother loading up an image...
Argument VARIABLE is the variable to define.
Argument IMAGESPEC is the list defining the image to create.
Argument DOCSTRING is the documentation for VARIABLE."
`(defvar ,variable nil ,docstring))
;; ELSE
(with-no-warnings
(defun ezimage-find-image-on-load-path (image)
"Find the image file IMAGE on the load path."
(let ((l (cons
;; In XEmacs, try the data directory first (for an
;; install in XEmacs proper.) Search the load
;; path next (for user installs)
(locate-data-directory "ezimage")
load-path))
(r nil))
(while (and l (not r))
(if (file-exists-p (concat (car l) "/" image))
(setq r (concat (car l) "/" image))
(if (file-exists-p (concat (car l) "/icons/" image))
(setq r (concat (car l) "/icons/" image))
))
(setq l (cdr l)))
r))
);with-no-warnings
(with-no-warnings
(defun ezimage-convert-emacs21-imagespec-to-xemacs (spec)
"Convert the Emacs21 image SPEC into an XEmacs image spec.
The Emacs 21 spec is what I first learned, and is easy to convert."
(let* ((sl (car spec))
(itype (nth 1 sl))
(ifile (nth 3 sl)))
(vector itype ':file (ezimage-find-image-on-load-path ifile))))
);with-no-warnings
(defmacro defezimage (variable imagespec docstring)
"Define VARIABLE as an image if `defimage' is not available.
IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
`(progn
(defvar ,variable
;; The Emacs21 version of defimage looks just like the XEmacs image
;; specifier, except that it needs a :type keyword. If we line
;; stuff up right, we can use this cheat to support XEmacs specifiers.
(condition-case nil
(make-glyph
(make-image-specifier
(ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
'buffer)
(error nil))
,docstring)
(put ',variable 'ezimage t)))
)))
(defezimage ezimage-directory
((:type xpm :file "ezimage/dir.xpm" :ascent center))
"Image used for empty directories.")
(defezimage ezimage-directory-plus
((:type xpm :file "ezimage/dir-plus.xpm" :ascent center))
"Image used for closed directories with stuff in them.")
(defezimage ezimage-directory-minus
((:type xpm :file "ezimage/dir-minus.xpm" :ascent center))
"Image used for open directories with stuff in them.")
(defezimage ezimage-page-plus
((:type xpm :file "ezimage/page-plus.xpm" :ascent center))
"Image used for closed files with stuff in them.")
(defezimage ezimage-page-minus
((:type xpm :file "ezimage/page-minus.xpm" :ascent center))
"Image used for open files with stuff in them.")
(defezimage ezimage-page
((:type xpm :file "ezimage/page.xpm" :ascent center))
"Image used for files with nothing interesting in it.")
(defezimage ezimage-tag
((:type xpm :file "ezimage/tag.xpm" :ascent center))
"Image used for tags.")
(defezimage ezimage-tag-plus
((:type xpm :file "ezimage/tag-plus.xpm" :ascent center))
"Image used for closed tag groups.")
(defezimage ezimage-tag-minus
((:type xpm :file "ezimage/tag-minus.xpm" :ascent center))
"Image used for open tags.")
(defezimage ezimage-tag-gt
((:type xpm :file "ezimage/tag-gt.xpm" :ascent center))
"Image used for closed tags (with twist arrow).")
(defezimage ezimage-tag-v
((:type xpm :file "ezimage/tag-v.xpm" :ascent center))
"Image used for open tags (with twist arrow).")
(defezimage ezimage-tag-type
((:type xpm :file "ezimage/tag-type.xpm" :ascent center))
"Image used for tags that represent a data type.")
(defezimage ezimage-box-plus
((:type xpm :file "ezimage/box-plus.xpm" :ascent center))
"Image of a closed box.")
(defezimage ezimage-box-minus
((:type xpm :file "ezimage/box-minus.xpm" :ascent center))
"Image of an open box.")
(defezimage ezimage-mail
((:type xpm :file "ezimage/mail.xpm" :ascent center))
"Image if an envelope.")
(defezimage ezimage-checkout
((:type xpm :file "ezimage/checkmark.xpm" :ascent center))
"Image representing a checkmark. For files checked out of a VC.")
(defezimage ezimage-object
((:type xpm :file "ezimage/bits.xpm" :ascent center))
"Image representing bits (an object file.)")
(defezimage ezimage-object-out-of-date
((:type xpm :file "ezimage/bitsbang.xpm" :ascent center))
"Image representing bits with a ! in it. (an out of data object file.)")
(defezimage ezimage-label
((:type xpm :file "ezimage/label.xpm" :ascent center))
"Image used for label prefix.")
(defezimage ezimage-lock
((:type xpm :file "ezimage/lock.xpm" :ascent center))
"Image of a lock. Used for Read Only, or private.")
(defezimage ezimage-unlock
((:type xpm :file "ezimage/unlock.xpm" :ascent center))
"Image of an unlocked lock.")
(defezimage ezimage-key
((:type xpm :file "ezimage/key.xpm" :ascent center))
"Image of a key.")
(defezimage ezimage-document-tag
((:type xpm :file "ezimage/doc.xpm" :ascent center))
"Image used to indicate documentation available.")
(defezimage ezimage-document-plus
((:type xpm :file "ezimage/doc-plus.xpm" :ascent center))
"Image used to indicate closed documentation.")
(defezimage ezimage-document-minus
((:type xpm :file "ezimage/doc-minus.xpm" :ascent center))
"Image used to indicate open documentation.")
(defezimage ezimage-info-tag
((:type xpm :file "ezimage/info.xpm" :ascent center))
"Image used to indicate more information available.")
(defvar ezimage-expand-image-button-alist
'(
;; here are some standard representations
("<+>" . ezimage-directory-plus)
("<->" . ezimage-directory-minus)
("< >" . ezimage-directory)
("[+]" . ezimage-page-plus)
("[-]" . ezimage-page-minus)
("[?]" . ezimage-page)
("[ ]" . ezimage-page)
("{+}" . ezimage-box-plus)
("{-}" . ezimage-box-minus)
;; Some vaguely representitive entries
("*" . ezimage-checkout)
("#" . ezimage-object)
("!" . ezimage-object-out-of-date)
("%" . ezimage-lock)
)
"List of text and image associations.")
(defun ezimage-insert-image-button-maybe (start length &optional string)
"Insert an image button based on text starting at START for LENGTH chars.
If buttontext is unknown, just insert that text.
If we have an image associated with it, use that image.
Optional argument STRING is a st ring upon which to add text properties."
(when ezimage-use-images
(let* ((bt (buffer-substring start (+ length start)))
(a (assoc bt ezimage-expand-image-button-alist)))
;; Regular images (created with `insert-image' are intangible
;; which (I suppose) make them more compatible with XEmacs 21.
;; Unfortunatly, there is a giant pile o code dependent on the
;; underlying text. This means if we leave it tangible, then I
;; don't have to change said giant piles o code.
(if (and a (symbol-value (cdr a)))
(ezimage-insert-over-text (symbol-value (cdr a))
start
(+ start (length bt))))))
string)
(defun ezimage-image-over-string (string &optional alist)
"Insert over the text in STRING an image found in ALIST.
Return STRING with properties applied."
(if ezimage-use-images
(let ((a (assoc string alist)))
(if (and a (symbol-value (cdr a)))
(ezimage-insert-over-text (symbol-value (cdr a))
0 (length string)
string)
string))
string))
(defun ezimage-insert-over-text (image start end &optional string)
"Place IMAGE over the text between START and END.
Assumes the image is part of a gui and can be clicked on.
Optional argument STRING is a string upon which to add text properties."
(when ezimage-use-images
(if (featurep 'xemacs)
(add-text-properties start end
(list 'end-glyph image
'rear-nonsticky (list 'display)
'invisible t
'detachable t)
string)
(add-text-properties start end
(list 'display image
'rear-nonsticky (list 'display))
string)))
string)
(defun ezimage-image-association-dump ()
"Dump out the current state of the Ezimage image alist.
See `ezimage-expand-image-button-alist' for details."
(interactive)
(with-output-to-temp-buffer "*Ezimage Images*"
(save-excursion
(set-buffer "*Ezimage Images*")
(goto-char (point-max))
(insert "Ezimage image cache.\n\n")
(let ((start (point)) (end nil))
(insert "Image\tText\tImage Name")
(setq end (point))
(insert "\n")
(put-text-property start end 'face 'underline))
(let ((ia ezimage-expand-image-button-alist))
(while ia
(let ((start (point)))
(insert (car (car ia)))
(insert "\t")
(ezimage-insert-image-button-maybe start
(length (car (car ia))))
(insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
(setq ia (cdr ia)))))))
(defun ezimage-image-dump ()
"Dump out the current state of the Ezimage image alist.
See `ezimage-expand-image-button-alist' for details."
(interactive)
(with-output-to-temp-buffer "*Ezimage Images*"
(save-excursion
(set-buffer "*Ezimage Images*")
(goto-char (point-max))
(insert "Ezimage image cache.\n\n")
(let ((start (point)) (end nil))
(insert "Image\tImage Name")
(setq end (point))
(insert "\n")
(put-text-property start end 'face 'underline))
(let ((ia (ezimage-all-images)))
(while ia
(let ((start (point)))
(insert "cm")
(ezimage-insert-over-text (symbol-value (car ia)) start (point))
(insert "\t" (format "%s" (car ia)) "\n"))
(setq ia (cdr ia)))))))
(defun ezimage-all-images ()
"Return a list of all variables containing ez images."
(let ((ans nil))
(mapatoms (lambda (sym)
(if (get sym 'ezimage) (setq ans (cons sym ans))))
)
(setq ans (sort ans (lambda (a b)
(string< (symbol-name a) (symbol-name b)))))
ans)
)
(provide 'ezimage)
;; arch-tag: d4ea2d93-3c7a-4cb3-b5a6-c1b9178183aa
;;; sb-image.el ends here

View file

@ -1,3 +1,31 @@
2005-10-04 Reiner Steib <Reiner.Steib@gmx.de>
* mm-url.el (mm-url-predefined-programs): Add switches for curl.
* gnus-util.el (gnus-remove-duplicates): Remove.
* nnmail.el (nnmail-article-group): Use mm-delete-duplicates
instead of gnus-remove-duplicates.
* message.el (message-remove-duplicates): Remove.
(message-idna-to-ascii-rhs-1): Use mm-delete-duplicates instead of
message-remove-duplicates.
* mm-util.el (mm-delete-duplicates): Use `delete-dups' if
available, else use implementation from `delete-dups'.
2005-10-02 Katsumi Yamaoka <yamaoka@jpl.org>
* time-date.el: Autoload parse-time-string, XEmacs needs it.
2005-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
* mm-decode.el (mm-inline-media-tests): Check presence of the diff-mode
function rather than the diff-mode.el package.
(mm-display-external): Use with-current-buffer.
(mm-viewer-completion-map, mm-viewer-completion-map):
Move initialization inside declaration.
2005-09-28 Reiner Steib <Reiner.Steib@gmx.de> 2005-09-28 Reiner Steib <Reiner.Steib@gmx.de>
* message.el: Remove useless autoloads. * message.el: Remove useless autoloads.
@ -16,10 +44,9 @@
* mm-uu.el (mm-uu-emacs-sources-regexp): Make variable * mm-uu.el (mm-uu-emacs-sources-regexp): Make variable
customizable. Change default value. customizable. Change default value.
(mm-uu-diff-groups-regexp): Change default value. (mm-uu-diff-groups-regexp): Change default value.
(mm-uu-type-alist): Added doc string. (mm-uu-type-alist): Add doc string.
(mm-uu-configure): Added doc string. Make it interactive. (mm-uu-configure): Add doc string. Make it interactive.
(mm-uu-diff-groups-regexp): Fix missing quotes from previous (mm-uu-diff-groups-regexp): Fix missing quotes from previous commit.
commit.
2005-09-27 Simon Josefsson <jas@extundo.com> 2005-09-27 Simon Josefsson <jas@extundo.com>
@ -75,8 +102,8 @@
2005-09-22 Reiner Steib <Reiner.Steib@gmx.de> 2005-09-22 Reiner Steib <Reiner.Steib@gmx.de>
* spam-report.el (spam-report-url-ping-plain): Use * spam-report.el (spam-report-url-ping-plain):
gnus-extended-version as User-Agent. Use gnus-extended-version as User-Agent.
* gnus-agent.el (gnus-agent-synchronize-flags): Explain why the * gnus-agent.el (gnus-agent-synchronize-flags): Explain why the
default value is nil. default value is nil.
@ -92,7 +119,7 @@
* mm-url.el (mm-url-decode-entities): Fix regexp. * mm-url.el (mm-url-decode-entities): Fix regexp.
2005-09-18 D Goel <deego@gnufans.org> 2005-09-18 Deepak Goel <deego@gnufans.org>
* sieve.el (sieve-help): Fix `message' call: first arg should be a * sieve.el (sieve-help): Fix `message' call: first arg should be a
format spec. format spec.
@ -125,9 +152,9 @@
2005-09-07 Reiner Steib <Reiner.Steib@gmx.de> 2005-09-07 Reiner Steib <Reiner.Steib@gmx.de>
* spam-report.el (spam-report-gmane): Make it work without * spam-report.el (spam-report-gmane): Make it work without
X-Report-Spam header. Gmane now only provides Archived-At. This X-Report-Spam header. Gmane now only provides Archived-At.
is only used if `spam-report-gmane-use-article-number' is nil. This is only used if `spam-report-gmane-use-article-number' is nil.
(spam-report-gmane-spam-header): Removed. Not used anymore. (spam-report-gmane-spam-header): Remove. Not used anymore.
* nnweb.el (nnweb-google-wash-article): Print a message if article * nnweb.el (nnweb-google-wash-article): Print a message if article
is not available. is not available.

View file

@ -7390,7 +7390,7 @@
instead of mm-auto-save-coding-system for the draft or delayed instead of mm-auto-save-coding-system for the draft or delayed
group. group.
2002-10-28 Josh <huber@alum.wpi.edu> 2002-10-28 Josh Huber <huber@alum.wpi.edu>
* mml.el (mml-mode-map): Fixed keybindings for mml-secure-* * mml.el (mml-mode-map): Fixed keybindings for mml-secure-*
functions. functions.

View file

@ -1037,14 +1037,6 @@ This function saves the current buffer."
(set-buffer gnus-group-buffer) (set-buffer gnus-group-buffer)
(eq major-mode 'gnus-group-mode)))) (eq major-mode 'gnus-group-mode))))
(defun gnus-remove-duplicates (list)
(let (new)
(while list
(or (member (car list) new)
(setq new (cons (car list) new)))
(setq list (cdr list)))
(nreverse new)))
(defun gnus-remove-if (predicate list) (defun gnus-remove-if (predicate list)
"Return a copy of LIST with all items satisfying PREDICATE removed." "Return a copy of LIST with all items satisfying PREDICATE removed."
(let (out) (let (out)

View file

@ -2027,14 +2027,6 @@ With prefix-argument just set Follow-Up, don't cross-post."
;;; End of functions adopted from `message-utils.el'. ;;; End of functions adopted from `message-utils.el'.
(defun message-remove-duplicates (list)
(let (new)
(while list
(or (member (car list) new)
(setq new (cons (car list) new)))
(setq list (cdr list)))
(nreverse new)))
(defun message-remove-header (header &optional is-regexp first reverse) (defun message-remove-header (header &optional is-regexp first reverse)
"Remove HEADER in the narrowed buffer. "Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression. If IS-REGEXP, HEADER is a regular expression.
@ -4963,7 +4955,7 @@ subscribed address (and not the additional To and Cc header contents)."
rhs ace address) rhs ace address)
(when field (when field
(dolist (rhs (dolist (rhs
(message-remove-duplicates (mm-delete-duplicates
(mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) "")) (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
(mapcar 'downcase (mapcar 'downcase
(mapcar (mapcar

View file

@ -222,7 +222,12 @@ before the external MIME handler is invoked."
("text/richtext" mm-inline-text identity) ("text/richtext" mm-inline-text identity)
("text/x-patch" mm-display-patch-inline ("text/x-patch" mm-display-patch-inline
(lambda (handle) (lambda (handle)
(locate-library "diff-mode"))) ;; If the diff-mode.el package is installed, the function is
;; autoloaded. Checking (locate-library "diff-mode") would be trying
;; to cater to broken installations. OTOH checking the function
;; makes it possible to install another package which provides an
;; alternative implementation of diff-mode. --Stef
(fboundp 'diff-mode)))
("application/emacs-lisp" mm-display-elisp-inline identity) ("application/emacs-lisp" mm-display-elisp-inline identity)
("application/x-emacs-lisp" mm-display-elisp-inline identity) ("application/x-emacs-lisp" mm-display-elisp-inline identity)
("text/html" ("text/html"
@ -451,21 +456,19 @@ If not set, `default-directory' will be used."
(defvar mm-viewer-completion-map (defvar mm-viewer-completion-map
(let ((map (make-sparse-keymap 'mm-viewer-completion-map))) (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
(set-keymap-parent map minibuffer-local-completion-map) (set-keymap-parent map minibuffer-local-completion-map)
;; Should we bind other key to minibuffer-complete-word?
(define-key map " " 'self-insert-command)
map) map)
"Keymap for input viewer with completion.") "Keymap for input viewer with completion.")
;; Should we bind other key to minibuffer-complete-word?
(define-key mm-viewer-completion-map " " 'self-insert-command)
(defvar mm-viewer-completion-map (defvar mm-viewer-completion-map
(let ((map (make-sparse-keymap 'mm-viewer-completion-map))) (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
(set-keymap-parent map minibuffer-local-completion-map) (set-keymap-parent map minibuffer-local-completion-map)
;; Should we bind other key to minibuffer-complete-word?
(define-key map " " 'self-insert-command)
map) map)
"Keymap for input viewer with completion.") "Keymap for input viewer with completion.")
;; Should we bind other key to minibuffer-complete-word?
(define-key mm-viewer-completion-map " " 'self-insert-command)
;;; The functions. ;;; The functions.
(defun mm-alist-to-plist (alist) (defun mm-alist-to-plist (alist)
@ -564,7 +567,7 @@ Postpone undisplaying of viewers for types in
;; what really needs to be done here is a way to link a ;; what really needs to be done here is a way to link a
;; MIME handle back to it's parent MIME handle (in a multilevel ;; MIME handle back to it's parent MIME handle (in a multilevel
;; MIME article). That would probably require changing ;; MIME article). That would probably require changing
;; the mm-handle API so we simply store the multipart buffert ;; the mm-handle API so we simply store the multipart buffer
;; name as a text property of the "multipart/whatever" string. ;; name as a text property of the "multipart/whatever" string.
(add-text-properties 0 (length (car ctl)) (add-text-properties 0 (length (car ctl))
(list 'buffer (mm-copy-to-buffer) (list 'buffer (mm-copy-to-buffer)
@ -807,8 +810,7 @@ external if displayed external."
(mm-mailcap-command (mm-mailcap-command
method file (mm-handle-type handle))) method file (mm-handle-type handle)))
(if (buffer-live-p buffer) (if (buffer-live-p buffer)
(save-excursion (with-current-buffer buffer
(set-buffer buffer)
(buffer-string)))) (buffer-string))))
(progn (progn
(ignore-errors (delete-file file)) (ignore-errors (delete-file file))

View file

@ -64,7 +64,7 @@
'((wget "wget" "--user-agent=mm-url" "-q" "-O" "-") '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-")
(w3m "w3m" "-dump_source") (w3m "w3m" "-dump_source")
(lynx "lynx" "-source") (lynx "lynx" "-source")
(curl "curl" "--silent"))) (curl "curl" "--silent" "--user-agent mm-url" "--location")))
(defcustom mm-url-program (defcustom mm-url-program
(cond (cond

View file

@ -538,14 +538,21 @@ If the charset is `composition', return the actual one."
;; This is for XEmacs. ;; This is for XEmacs.
(mm-mule-charset-to-mime-charset charset))) (mm-mule-charset-to-mime-charset charset)))
(defun mm-delete-duplicates (list) (if (fboundp 'delete-dups)
"Simple substitute for CL `delete-duplicates', testing with `equal'." (defalias 'mm-delete-duplicates 'delete-dups)
(let (result head) (defun mm-delete-duplicates (list)
(while list "Destructively remove `equal' duplicates from LIST.
(setq head (car list)) Store the result in LIST and return it. LIST must be a proper list.
(setq list (delete head list)) Of several `equal' occurrences of an element in LIST, the first
(setq result (cons head result))) one is kept.
(nreverse result)))
This is a compatibility function for Emacsen without `delete-dups'."
;; Code from `subr.el' in Emacs 22:
(let ((tail list))
(while tail
(setcdr tail (delete (car tail) (cdr tail)))
(setq tail (cdr tail))))
list))
;; Fixme: This is used in places when it should be testing the ;; Fixme: This is used in places when it should be testing the
;; default multibyteness. See mm-default-multibyte-p. ;; default multibyteness. See mm-default-multibyte-p.

View file

@ -1142,7 +1142,7 @@ FUNC will be called with the group name to determine the article number."
5 "Error in `nnmail-split-methods'; using `bogus' mail group") 5 "Error in `nnmail-split-methods'; using `bogus' mail group")
(sit-for 1) (sit-for 1)
'("bogus"))))) '("bogus")))))
(setq split (gnus-remove-duplicates split)) (setq split (mm-delete-duplicates split))
;; The article may be "cross-posted" to `junk'. What ;; The article may be "cross-posted" to `junk'. What
;; to do? Just remove the `junk' spec. Don't really ;; to do? Just remove the `junk' spec. Don't really
;; see anything else to do... ;; see anything else to do...

View file

@ -354,7 +354,7 @@ Setting this variable directly does not take effect;
use either \\[customize] or the function `ido-mode'." use either \\[customize] or the function `ido-mode'."
:set #'(lambda (symbol value) :set #'(lambda (symbol value)
(ido-mode value)) (ido-mode value))
:initialize 'custom-initialize-default :initialize 'custom-initialize-set
:require 'ido :require 'ido
:link '(emacs-commentary-link "ido.el") :link '(emacs-commentary-link "ido.el")
:set-after '(ido-save-directory-list-file) :set-after '(ido-save-directory-list-file)

View file

@ -1845,36 +1845,45 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat."
(defun Info-next () (defun Info-next ()
"Go to the next node of this node." "Go to the next node of this node."
(interactive) (interactive)
(Info-goto-node (Info-extract-pointer "next"))) ;; In case another window is currently selected
(save-window-excursion
(or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
(Info-goto-node (Info-extract-pointer "next"))))
(defun Info-prev () (defun Info-prev ()
"Go to the previous node of this node." "Go to the previous node of this node."
(interactive) (interactive)
(Info-goto-node (Info-extract-pointer "prev[ious]*" "previous"))) ;; In case another window is currently selected
(save-window-excursion
(or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
(Info-goto-node (Info-extract-pointer "prev[ious]*" "previous"))))
(defun Info-up (&optional same-file) (defun Info-up (&optional same-file)
"Go to the superior node of this node. "Go to the superior node of this node.
If SAME-FILE is non-nil, do not move to a different Info file." If SAME-FILE is non-nil, do not move to a different Info file."
(interactive) (interactive)
(let ((old-node Info-current-node) ;; In case another window is currently selected
(old-file Info-current-file) (save-window-excursion
(node (Info-extract-pointer "up")) p) (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
(and (or same-file (not (stringp Info-current-file))) (let ((old-node Info-current-node)
(string-match "^(" node) (old-file Info-current-file)
(error "Up node is in another Info file")) (node (Info-extract-pointer "up")) p)
(Info-goto-node node) (and (or same-file (not (stringp Info-current-file)))
(setq p (point)) (string-match "^(" node)
(goto-char (point-min)) (error "Up node is in another Info file"))
(if (and (search-forward "\n* Menu:" nil t) (Info-goto-node node)
(re-search-forward (setq p (point))
(if (string-equal old-node "Top") (goto-char (point-min))
(concat "\n\\*[^:]+: +(" (file-name-nondirectory old-file) ")") (if (and (search-forward "\n* Menu:" nil t)
(concat "\n\\* +\\(" (regexp-quote old-node) (re-search-forward
":\\|[^:]+: +" (regexp-quote old-node) "\\)")) (if (string-equal old-node "Top")
nil t)) (concat "\n\\*[^:]+: +(" (file-name-nondirectory old-file) ")")
(progn (beginning-of-line) (if (looking-at "^\\* ") (forward-char 2))) (concat "\n\\* +\\(" (regexp-quote old-node)
(goto-char p) ":\\|[^:]+: +" (regexp-quote old-node) "\\)"))
(Info-restore-point Info-history)))) nil t))
(progn (beginning-of-line) (if (looking-at "^\\* ") (forward-char 2)))
(goto-char p)
(Info-restore-point Info-history)))))
(defun Info-history-back () (defun Info-history-back ()
"Go back in the history to the last node visited." "Go back in the history to the last node visited."
@ -4012,8 +4021,6 @@ This will add a speedbar major display mode."
(speedbar-change-initial-expansion-list "Info") (speedbar-change-initial-expansion-list "Info")
) )
(eval-when-compile (defvar speedbar-attached-frame))
(defun Info-speedbar-hierarchy-buttons (directory depth &optional node) (defun Info-speedbar-hierarchy-buttons (directory depth &optional node)
"Display an Info directory hierarchy in speedbar. "Display an Info directory hierarchy in speedbar.
DIRECTORY is the current directory in the attached frame. DIRECTORY is the current directory in the attached frame.
@ -4030,13 +4037,12 @@ specific node to expand."
;; being known at creation time. ;; being known at creation time.
(if (not node) (if (not node)
(speedbar-with-writable (insert "Info Nodes:\n"))) (speedbar-with-writable (insert "Info Nodes:\n")))
(let ((completions nil) (let ((completions nil))
(cf (selected-frame))) (speedbar-select-attached-frame)
(select-frame speedbar-attached-frame)
(save-window-excursion (save-window-excursion
(setq completions (setq completions
(Info-speedbar-fetch-file-nodes (or node '"(dir)top")))) (Info-speedbar-fetch-file-nodes (or node '"(dir)top"))))
(select-frame cf) (select-frame (speedbar-current-frame))
(if completions (if completions
(speedbar-with-writable (speedbar-with-writable
(dolist (completion completions) (dolist (completion completions)
@ -4052,7 +4058,7 @@ specific node to expand."
(defun Info-speedbar-goto-node (text node indent) (defun Info-speedbar-goto-node (text node indent)
"When user clicks on TEXT, go to an info NODE. "When user clicks on TEXT, go to an info NODE.
The INDENT level is ignored." The INDENT level is ignored."
(select-frame speedbar-attached-frame) (speedbar-select-attached-frame)
(let* ((buff (or (get-buffer "*info*") (let* ((buff (or (get-buffer "*info*")
(progn (info) (get-buffer "*info*")))) (progn (info) (get-buffer "*info*"))))
(bwin (get-buffer-window buff 0))) (bwin (get-buffer-window buff 0)))
@ -4062,7 +4068,7 @@ The INDENT level is ignored."
(raise-frame (window-frame bwin))) (raise-frame (window-frame bwin)))
(if speedbar-power-click (if speedbar-power-click
(let ((pop-up-frames t)) (select-window (display-buffer buff))) (let ((pop-up-frames t)) (select-window (display-buffer buff)))
(select-frame speedbar-attached-frame) (speedbar-select-attached-frame)
(switch-to-buffer buff))) (switch-to-buffer buff)))
(if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" node)) (if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" node))
(error "Invalid node %s" node) (error "Invalid node %s" node)
@ -4128,7 +4134,7 @@ NODESPEC is a string of the form: (file)node."
(nreverse completions)))) (nreverse completions))))
;;; Info mode node listing ;;; Info mode node listing
;; FIXME: Seems not to be used. -stef ;; This is called by `speedbar-add-localized-speedbar-support'
(defun Info-speedbar-buttons (buffer) (defun Info-speedbar-buttons (buffer)
"Create a speedbar display to help navigation in an Info file. "Create a speedbar display to help navigation in an Info file.
BUFFER is the buffer speedbar is requesting buttons for." BUFFER is the buffer speedbar is requesting buttons for."
@ -4136,8 +4142,7 @@ BUFFER is the buffer speedbar is requesting buttons for."
(let ((case-fold-search t)) (let ((case-fold-search t))
(not (looking-at "Info Nodes:")))) (not (looking-at "Info Nodes:"))))
(erase-buffer)) (erase-buffer))
(Info-speedbar-hierarchy-buttons nil 0) (Info-speedbar-hierarchy-buttons nil 0))
)
(dolist (mess '("^First node in file$" (dolist (mess '("^First node in file$"
"^No `.*' in index$" "^No `.*' in index$"

View file

@ -293,6 +293,7 @@ with a space, for which the regexp is `^ '. See the source file for
example functions that filter buffernames." example functions that filter buffernames."
:type '(repeat (choice regexp function)) :type '(repeat (choice regexp function))
:group 'iswitchb) :group 'iswitchb)
(put 'iswitchb-buffer-ignore 'risky-local-variable t)
(defcustom iswitchb-max-to-show nil (defcustom iswitchb-max-to-show nil
"*If non-nil, limit the number of names shown in the minibuffer. "*If non-nil, limit the number of names shown in the minibuffer.
@ -942,7 +943,7 @@ BUFFER-LIST can be list of buffers or list of strings."
(progn (progn
(setq ignorep t) (setq ignorep t)
(setq re-list nil)))) (setq re-list nil))))
((fboundp nextstr) ((functionp nextstr)
(if (funcall nextstr bufname) (if (funcall nextstr bufname)
(progn (progn
(setq ignorep t) (setq ignorep t)

View file

@ -3,7 +3,7 @@
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; Author: Bill Carpenter <bill@bubblegum.net>, <bill@carpenter.ORG> ;; Author: Bill Carpenter <bill@carpenter.ORG>
;; Version: 8 ;; Version: 8
;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft ;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft
;; X-URL: <URL:http://www.carpenter.org/feedmail/feedmail.html> ;; X-URL: <URL:http://www.carpenter.org/feedmail/feedmail.html>

View file

@ -1,3 +1,14 @@
2005-09-30 Bill Wohler <wohler@newt.com>
* mh-customize.el (mh-refile-msg, mh-tool-bar-reply-from)
(mh-tool-bar-reply-to, mh-tool-bar-reply-all)
(mh-alias-grab-from-field, mh-pack-folder): Image files moved to
etc/images/mail so added "mail/" prefix.
(mh-reply): Ditto. Also renamed reply2.* to reply.*.
(mh-rescan-folder): Ditto. Renamed image file to refresh.* since
it can be used in the general sense. Does not have "mail/"
prefix.
2005-09-24 Emilio C. Lopes <eclig@gmx.net> 2005-09-24 Emilio C. Lopes <eclig@gmx.net>
* mh-mime.el (mh-compose-forward, mh-mhn-compose-forw): * mh-mime.el (mh-compose-forward, mh-mhn-compose-forw):

View file

@ -1922,7 +1922,7 @@ This button runs `mh-previous-undeleted-msg'")
"Go to the next undeleted message\nThe button runs `mh-next-undeleted-msg'") "Go to the next undeleted message\nThe button runs `mh-next-undeleted-msg'")
(mh-delete-msg (folder) "close" (mh-delete-msg (folder) "close"
"Mark this message for deletion\nThis button runs `mh-delete-msg'") "Mark this message for deletion\nThis button runs `mh-delete-msg'")
(mh-refile-msg (folder) "refile" (mh-refile-msg (folder) "mail/refile"
"Refile this message\nThis button runs `mh-refile-msg'") "Refile this message\nThis button runs `mh-refile-msg'")
(mh-undo (folder) "undo" "Undo last operation\nThis button runs `undo'" (mh-undo (folder) "undo" "Undo last operation\nThis button runs `undo'"
(mh-outstanding-commands-p)) (mh-outstanding-commands-p))
@ -1933,19 +1933,19 @@ This button runs `mh-previous-undeleted-msg'")
"Toggle tick mark\nThis button runs `mh-toggle-tick'") "Toggle tick mark\nThis button runs `mh-toggle-tick'")
(mh-toggle-showing (folder) "show" (mh-toggle-showing (folder) "show"
"Toggle showing message\nThis button runs `mh-toggle-showing'") "Toggle showing message\nThis button runs `mh-toggle-showing'")
(mh-tool-bar-reply-from (folder) "reply-from" "Reply to \"from\"") (mh-tool-bar-reply-from (folder) "mail/reply-from" "Reply to \"from\"")
(mh-tool-bar-reply-to (folder) "reply-to" "Reply to \"to\"") (mh-tool-bar-reply-to (folder) "mail/reply-to" "Reply to \"to\"")
(mh-tool-bar-reply-all (folder) "reply-all" "Reply to \"all\"") (mh-tool-bar-reply-all (folder) "mail/reply-all" "Reply to \"all\"")
(mh-reply (folder) "mail/reply2" (mh-reply (folder) "mail/reply"
"Reply to this message\nThis button runs `mh-reply'") "Reply to this message\nThis button runs `mh-reply'")
(mh-alias-grab-from-field (folder) "alias" (mh-alias-grab-from-field (folder) "mail/alias"
"Grab From alias\nThis button runs `mh-alias-grab-from-field'" "Grab From alias\nThis button runs `mh-alias-grab-from-field'"
(and (mh-extract-from-header-value) (not (mh-alias-for-from-p)))) (and (mh-extract-from-header-value) (not (mh-alias-for-from-p))))
(mh-send (folder) "mail_compose" (mh-send (folder) "mail_compose"
"Compose new message\nThis button runs `mh-send'") "Compose new message\nThis button runs `mh-send'")
(mh-rescan-folder (folder) "rescan" (mh-rescan-folder (folder) "refresh"
"Rescan this folder\nThis button runs `mh-rescan-folder'") "Rescan this folder\nThis button runs `mh-rescan-folder'")
(mh-pack-folder (folder) "repack" (mh-pack-folder (folder) "mail/repack"
"Repack this folder\nThis button runs `mh-pack-folder'") "Repack this folder\nThis button runs `mh-pack-folder'")
(mh-tool-bar-search (folder) "search" (mh-tool-bar-search (folder) "search"
"Search\nThis button runs `mh-tool-bar-search-function'") "Search\nThis button runs `mh-tool-bar-search-function'")

View file

@ -1298,6 +1298,8 @@ only return the directory part of FILE."
(setq file (setq file
(if (file-name-absolute-p temp) (if (file-name-absolute-p temp)
temp temp
;; Wouldn't `expand-file-name' be better than `concat' ?
;; It would fail when `a/b/..' != `a', tho. --Stef
(concat (file-name-directory file) temp))))) (concat (file-name-directory file) temp)))))
file) file)
@ -1385,12 +1387,12 @@ only return the directory part of FILE."
(if (or ange-ftp-disable-netrc-security-check (if (or ange-ftp-disable-netrc-security-check
(and (eq (nth 2 attr) (user-uid)) ; Same uids. (and (eq (nth 2 attr) (user-uid)) ; Same uids.
(string-match ".r..------" (nth 8 attr)))) (string-match ".r..------" (nth 8 attr))))
(save-excursion (with-current-buffer
;; we are cheating a bit here. I'm trying to do the equivalent ;; we are cheating a bit here. I'm trying to do the equivalent
;; of find-file on the .netrc file, but then nuke it afterwards. ;; of find-file on the .netrc file, but then nuke it afterwards.
;; with the bit of logic below we should be able to have ;; with the bit of logic below we should be able to have
;; encrypted .netrc files. ;; encrypted .netrc files.
(set-buffer (generate-new-buffer "*ftp-.netrc*")) (generate-new-buffer "*ftp-.netrc*")
(ange-ftp-real-insert-file-contents file) (ange-ftp-real-insert-file-contents file)
(setq buffer-file-name file) (setq buffer-file-name file)
(setq default-directory (file-name-directory file)) (setq default-directory (file-name-directory file))
@ -1511,7 +1513,7 @@ then kill the related ftp process."
(setq buffer (current-buffer)) (setq buffer (current-buffer))
(setq buffer (get-buffer buffer))) (setq buffer (get-buffer buffer)))
(let ((file (or (buffer-file-name buffer) (let ((file (or (buffer-file-name buffer)
(save-excursion (set-buffer buffer) default-directory)))) (with-current-buffer buffer default-directory))))
(if file (if file
(let ((parsed (ange-ftp-ftp-name (expand-file-name file)))) (let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
(if parsed (if parsed
@ -1592,8 +1594,7 @@ good, skip, fatal, or unknown."
(if proc (if proc
(let ((buf (process-buffer proc))) (let ((buf (process-buffer proc)))
(if buf (if buf
(save-excursion (with-current-buffer buf
(set-buffer buf)
(setq ange-ftp-xfer-size (setq ange-ftp-xfer-size
;; For very large files, BYTES can be a float. ;; For very large files, BYTES can be a float.
(if (integerp bytes) (if (integerp bytes)
@ -1763,8 +1764,7 @@ good, skip, fatal, or unknown."
(defun ange-ftp-gwp-filter (proc str) (defun ange-ftp-gwp-filter (proc str)
(comint-output-filter proc str) (comint-output-filter proc str)
(save-excursion (with-current-buffer (process-buffer proc)
(set-buffer (process-buffer proc))
;; Replace STR by the result of the comint processing. ;; Replace STR by the result of the comint processing.
(setq str (buffer-substring comint-last-output-start (process-mark proc)))) (setq str (buffer-substring comint-last-output-start (process-mark proc))))
(cond ((string-match "login: *$" str) (cond ((string-match "login: *$" str)
@ -1800,8 +1800,7 @@ good, skip, fatal, or unknown."
(set-process-query-on-exit-flag proc nil) (set-process-query-on-exit-flag proc nil)
(set-process-sentinel proc 'ange-ftp-gwp-sentinel) (set-process-sentinel proc 'ange-ftp-gwp-sentinel)
(set-process-filter proc 'ange-ftp-gwp-filter) (set-process-filter proc 'ange-ftp-gwp-filter)
(save-excursion (with-current-buffer (process-buffer proc)
(set-buffer (process-buffer proc))
(goto-char (point-max)) (goto-char (point-max))
(set-marker (process-mark proc) (point))) (set-marker (process-mark proc) (point)))
(setq ange-ftp-gwp-running t (setq ange-ftp-gwp-running t
@ -1907,8 +1906,7 @@ been queued with no result. CONT will still be called, however."
ange-ftp-nslookup-program host))) ange-ftp-nslookup-program host)))
(res host)) (res host))
(set-process-query-on-exit-flag proc nil) (set-process-query-on-exit-flag proc nil)
(save-excursion (with-current-buffer (process-buffer proc)
(set-buffer (process-buffer proc))
(while (memq (process-status proc) '(run open)) (while (memq (process-status proc) '(run open))
(accept-process-output proc)) (accept-process-output proc))
(goto-char (point-min)) (goto-char (point-min))
@ -1947,8 +1945,7 @@ on the gateway machine to do the ftp instead."
;; Copy this so we don't alter it permanently. ;; Copy this so we don't alter it permanently.
(process-environment (copy-tree process-environment)) (process-environment (copy-tree process-environment))
(buffer (get-buffer-create name))) (buffer (get-buffer-create name)))
(save-excursion (with-current-buffer buffer
(set-buffer buffer)
(internal-ange-ftp-mode)) (internal-ange-ftp-mode))
;; This tells GNU ftp not to output any fancy escape sequences. ;; This tells GNU ftp not to output any fancy escape sequences.
(setenv "TERM" "dumb") (setenv "TERM" "dumb")
@ -1960,8 +1957,7 @@ on the gateway machine to do the ftp instead."
ange-ftp-gateway-host) ange-ftp-gateway-host)
args)))) args))))
(setq proc (apply 'start-process name name args)))) (setq proc (apply 'start-process name name args))))
(save-excursion (with-current-buffer (process-buffer proc)
(set-buffer (process-buffer proc))
(goto-char (point-max)) (goto-char (point-max))
(set-marker (process-mark proc) (point))) (set-marker (process-mark proc) (point)))
(set-process-query-on-exit-flag proc nil) (set-process-query-on-exit-flag proc nil)
@ -2127,8 +2123,7 @@ suffix of the form #PORT to specify a non-default port"
(defun ange-ftp-guess-hash-mark-size (proc) (defun ange-ftp-guess-hash-mark-size (proc)
(if ange-ftp-send-hash (if ange-ftp-send-hash
(save-excursion (with-current-buffer (process-buffer proc)
(set-buffer (process-buffer proc))
(let* ((status (ange-ftp-raw-send-cmd proc "hash")) (let* ((status (ange-ftp-raw-send-cmd proc "hash"))
(line (cdr status))) (line (cdr status)))
(save-match-data (save-match-data
@ -2308,6 +2303,14 @@ and NOWAIT."
(not (string-match "R" cmd3)) (not (string-match "R" cmd3))
(setq cmd1 (concat cmd1 "."))) (setq cmd1 (concat cmd1 ".")))
;; Using "ls -flags foo" has several problems:
;; - if foo is a symlink, we may get a single line showing the symlink
;; rather than the listing of the directory it points to.
;; - if "foo" has spaces, the parsing of the command may be done wrong.
;; - some version of netbsd's ftpd only accept a single argument after
;; `ls', which can either be the directory or the flags.
;; So to work around those problems, we use "cd foo; ls -flags".
;; If the dir name contains a space, some ftp servers will ;; If the dir name contains a space, some ftp servers will
;; refuse to list it. We instead change directory to the ;; refuse to list it. We instead change directory to the
;; directory in question and ls ".". ;; directory in question and ls ".".
@ -2324,14 +2327,14 @@ and NOWAIT."
;; This works around a misfeature of some versions of netbsd ftpd ;; This works around a misfeature of some versions of netbsd ftpd
;; where `ls' can only take one argument: either one set of flags ;; where `ls' can only take one argument: either one set of flags
;; or a file/directory name. ;; or a file/directory name.
;; FIXME: if we're trying to `ls' a single file, this fails since we ;; If we're trying to `ls' a single file, this fails since we
;; can't cd to a file. We can't fix this problem here, tho, because ;; can't cd to a file. We can't fix this problem here, tho, because
;; at this point we don't know whether the argument is a file or ;; at this point we don't know whether the argument is a file or
;; a directory. Such an `ls' is only every used (apparently) from ;; a directory. Such an `ls' is only ever used (apparently) from
;; `insert-directory' when the `full-directory-p' argument is nil ;; `insert-directory' when the `full-directory-p' argument is nil
;; (which seems to only be used by dired when updating its display ;; (which seems to only be used by dired when updating its display
;; after operating on a set of files). We should change ;; after operating on a set of files). So we've changed
;; ange-ftp-insert-directory so that this case is handled by getting ;; `ange-ftp-insert-directory' such that in this case it gets
;; a full listing of the directory and extracting the line ;; a full listing of the directory and extracting the line
;; corresponding to the requested file. ;; corresponding to the requested file.
(unless (equal cmd1 ".") (unless (equal cmd1 ".")
@ -2606,9 +2609,8 @@ away in the internal cache."
(format "Listing %s" (format "Listing %s"
(ange-ftp-abbreviate-filename (ange-ftp-abbreviate-filename
ange-ftp-this-file))))) ange-ftp-this-file)))))
(save-excursion (with-current-buffer (get-buffer-create
(set-buffer (get-buffer-create ange-ftp-data-buffer-name)
ange-ftp-data-buffer-name))
(erase-buffer) (erase-buffer)
(if (ange-ftp-real-file-readable-p temp) (if (ange-ftp-real-file-readable-p temp)
(ange-ftp-real-insert-file-contents temp) (ange-ftp-real-insert-file-contents temp)
@ -3022,8 +3024,7 @@ this also returns nil."
(let ((result (ange-ftp-send-cmd host user '(type "binary")))) (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
(if (not (car result)) (if (not (car result))
(ange-ftp-error host user (concat "BINARY failed: " (cdr result))) (ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
(save-excursion (with-current-buffer (process-buffer (ange-ftp-get-process host user))
(set-buffer (process-buffer (ange-ftp-get-process host user)))
(and ange-ftp-binary-hash-mark-size (and ange-ftp-binary-hash-mark-size
(setq ange-ftp-hash-mark-unit (setq ange-ftp-hash-mark-unit
(ash ange-ftp-binary-hash-mark-size -4))))))) (ash ange-ftp-binary-hash-mark-size -4)))))))
@ -3033,8 +3034,7 @@ this also returns nil."
(let ((result (ange-ftp-send-cmd host user '(type "ascii")))) (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
(if (not (car result)) (if (not (car result))
(ange-ftp-error host user (concat "ASCII failed: " (cdr result))) (ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
(save-excursion (with-current-buffer (process-buffer (ange-ftp-get-process host user))
(set-buffer (process-buffer (ange-ftp-get-process host user)))
(and ange-ftp-ascii-hash-mark-size (and ange-ftp-ascii-hash-mark-size
(setq ange-ftp-hash-mark-unit (setq ange-ftp-hash-mark-unit
(ash ange-ftp-ascii-hash-mark-size -4))))))) (ash ange-ftp-ascii-hash-mark-size -4)))))))
@ -3174,7 +3174,7 @@ logged in as user USER and cd'd to directory DIR."
(ange-ftp-real-file-name-directory n)))))) (ange-ftp-real-file-name-directory n))))))
(defun ange-ftp-expand-file-name (name &optional default) (defun ange-ftp-expand-file-name (name &optional default)
"Documented as original." "Documented as `expand-file-name'."
(save-match-data (save-match-data
(setq default (or default default-directory)) (setq default (or default default-directory))
(cond ((eq (string-to-char name) ?~) (cond ((eq (string-to-char name) ?~)
@ -3289,7 +3289,7 @@ system TYPE.")
;; cleanup forms ;; cleanup forms
(setq coding-system-used last-coding-system-used) (setq coding-system-used last-coding-system-used)
(setq buffer-file-name filename) (setq buffer-file-name filename)
(set-buffer-modified-p mod-p))) (restore-buffer-modified-p mod-p)))
(if binary (if binary
(ange-ftp-set-binary-mode host user)) (ange-ftp-set-binary-mode host user))
@ -3448,7 +3448,9 @@ system TYPE.")
(let ((file-ent (ange-ftp-get-file-entry (let ((file-ent (ange-ftp-get-file-entry
(ange-ftp-file-name-as-directory name)))) (ange-ftp-file-name-as-directory name))))
(if (stringp file-ent) (if (stringp file-ent)
(file-directory-p ;; Calling file-directory-p doesn't work because ange-ftp
;; is temporarily disabled for this operation.
(ange-ftp-file-directory-p
(ange-ftp-expand-symlink file-ent (ange-ftp-expand-symlink file-ent
(file-name-directory (file-name-directory
(directory-file-name name)))) (directory-file-name name))))
@ -3640,8 +3642,7 @@ Value is (0 0) if the modification time cannot be determined."
;; (set (make-local-variable 'copy-cont) cont)))) ;; (set (make-local-variable 'copy-cont) cont))))
;; ;;
;; (defun ange-ftp-copy-file-locally-sentinel (proc status) ;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
;; (save-excursion ;; (with-current-buffer (process-buffer proc)
;; (set-buffer (process-buffer proc))
;; (let ((cont copy-cont) ;; (let ((cont copy-cont)
;; (result (buffer-string))) ;; (result (buffer-string)))
;; (unwind-protect ;; (unwind-protect
@ -4476,21 +4477,38 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;; `ange-ftp-ls' handles this. ;; `ange-ftp-ls' handles this.
(defun ange-ftp-insert-directory (file switches &optional wildcard full) (defun ange-ftp-insert-directory (file switches &optional wildcard full)
(let ((parsed (ange-ftp-ftp-name (expand-file-name file))) (if (not (ange-ftp-ftp-name (expand-file-name file)))
tem) (ange-ftp-real-insert-directory file switches wildcard full)
(if parsed ;; We used to follow symlinks on `file' here. Apparently it was done
(if (and (not wildcard) ;; because some FTP servers react to "ls foo" by listing the symlink foo
(setq tem (file-symlink-p (directory-file-name file)))) ;; rather than the directory it points to. Now that ange-ftp-ls uses
(ange-ftp-insert-directory ;; "cd foo; ls" instead, this is not necesssary any more.
(ange-ftp-expand-symlink (insert
tem (file-name-directory (directory-file-name file))) (cond
switches wildcard full) (wildcard
(insert (let ((default-directory (file-name-directory file)))
(if wildcard (ange-ftp-ls (file-name-nondirectory file) switches nil nil t)))
(let ((default-directory (file-name-directory file))) (full
(ange-ftp-ls (file-name-nondirectory file) switches nil nil t)) (ange-ftp-ls file switches 'parse))
(ange-ftp-ls file switches full)))) (t
(ange-ftp-real-insert-directory file switches wildcard full)))) ;; If `full' is nil we're going to do `ls' for a single file.
;; Problem is that for various reasons, ange-ftp-ls needs to cd and
;; then do an ls of current dir, which obviously won't work if we
;; want to ls a file. So instead, we get a full listing of the
;; parent directory and extract the line corresponding to `file'.
(when (string-match "d\\'" switches)
;; Remove "d" which dired added to `switches'.
(setq switches (substring switches 0 (match-beginning 0))))
(let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".")
switches nil))
(filename (file-name-nondirectory (directory-file-name file)))
(case-fold-search nil))
;; FIXME: This presumes a particular output format, which is
;; basically Unix.
(if (string-match (concat "^.+[^ ] " (regexp-quote filename)
"\\( -> .*\\)?[@/*=]?\n") dirlist)
(match-string 0 dirlist)
"")))))))
(defun ange-ftp-dired-uncache (dir) (defun ange-ftp-dired-uncache (dir)
(if (ange-ftp-ftp-name (expand-file-name dir)) (if (ange-ftp-ftp-name (expand-file-name dir))
@ -4502,10 +4520,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(defun ange-ftp-file-name-sans-versions (file keep-backup-version) (defun ange-ftp-file-name-sans-versions (file keep-backup-version)
(let* ((short (ange-ftp-abbreviate-filename file)) (let* ((short (ange-ftp-abbreviate-filename file))
(parsed (ange-ftp-ftp-name short)) (parsed (ange-ftp-ftp-name short))
func) (func (if parsed (cdr (assq (ange-ftp-host-type (car parsed))
(if parsed ange-ftp-sans-version-alist)))))
(setq func (cdr (assq (ange-ftp-host-type (car parsed))
ange-ftp-sans-version-alist))))
(if func (funcall func file keep-backup-version) (if func (funcall func file keep-backup-version)
(ange-ftp-real-file-name-sans-versions file keep-backup-version)))) (ange-ftp-real-file-name-sans-versions file keep-backup-version))))
@ -4649,10 +4665,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;; target marker-char buffer overwrite-query ;; target marker-char buffer overwrite-query
;; overwrite-backup-query failures skipped ;; overwrite-backup-query failures skipped
;; success-count total) ;; success-count total)
;; (let ((old-buf (current-buffer))) ;; (with-current-buffer buffer
;; (unwind-protect
;; (progn
;; (set-buffer buffer)
;; (if (null fn-list) ;; (if (null fn-list)
;; (ange-ftp-dcf-3 failures operation total skipped ;; (ange-ftp-dcf-3 failures operation total skipped
;; success-count buffer) ;; success-count buffer)
@ -4724,8 +4737,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;; overwrite-query ;; overwrite-query
;; overwrite-backup-query ;; overwrite-backup-query
;; failures skipped success-count ;; failures skipped success-count
;; total)))))))) ;; total)))))))))
;; (set-buffer old-buf))))
;;(defun ange-ftp-dcf-2 (result line err ;;(defun ange-ftp-dcf-2 (result line err
;; file-creator operation fn-list ;; file-creator operation fn-list
@ -4739,10 +4751,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;; overwrite-backup-query ;; overwrite-backup-query
;; failures skipped success-count ;; failures skipped success-count
;; total) ;; total)
;; (let ((old-buf (current-buffer))) ;; (with-current-buffer buffer
;; (unwind-protect
;; (progn
;; (set-buffer buffer)
;; (if (or err (not result)) ;; (if (or err (not result))
;; (progn ;; (progn
;; (setq failures (cons (dired-make-relative from) failures)) ;; (setq failures (cons (dired-make-relative from) failures))
@ -4765,15 +4774,11 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;; overwrite-query ;; overwrite-query
;; overwrite-backup-query ;; overwrite-backup-query
;; failures skipped success-count ;; failures skipped success-count
;; total)) ;; total)))
;; (set-buffer old-buf))))
;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count ;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
;; buffer) ;; buffer)
;; (let ((old-buf (current-buffer))) ;; (with-current-buffer buffer
;; (unwind-protect
;; (progn
;; (set-buffer buffer)
;; (cond ;; (cond
;; (failures ;; (failures
;; (dired-log-summary ;; (dired-log-summary
@ -4788,8 +4793,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;; (t ;; (t
;; (message "%s: %s file%s." ;; (message "%s: %s file%s."
;; operation success-count (dired-plural-s success-count)))) ;; operation success-count (dired-plural-s success-count))))
;; (dired-move-to-filename)) ;; (dired-move-to-filename)))
;; (set-buffer old-buf))))
;;;; ----------------------------------------------- ;;;; -----------------------------------------------
;;;; Unix Descriptive Listing (dl) Support ;;;; Unix Descriptive Listing (dl) Support

View file

@ -136,7 +136,7 @@ Nil means to use a separate filename syntax for Tramp.")
;; Avoid byte-compiler warnings if the byte-compiler supports this. ;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this. ;; Currently, XEmacs supports this.
(eval-when-compile (eval-when-compile
(when (fboundp 'byte-compiler-options) (when (featurep 'xemacs)
(let (unused-vars) ; Pacify Emacs byte-compiler (let (unused-vars) ; Pacify Emacs byte-compiler
(defalias 'warnings 'identity) ; Pacify Emacs byte-compiler (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
(byte-compiler-options (warnings (- unused-vars)))))) (byte-compiler-options (warnings (- unused-vars))))))
@ -3681,7 +3681,7 @@ This will break if COMMAND prints a newline, followed by the value of
(let ((tmpbuf (get-buffer-create " *tramp tmp*"))) (let ((tmpbuf (get-buffer-create " *tramp tmp*")))
(set-buffer tmpbuf) (set-buffer tmpbuf)
(erase-buffer) (erase-buffer)
(insert-buffer tramp-buf) (insert-buffer-substring tramp-buf)
(tramp-message-for-buffer (tramp-message-for-buffer
multi-method method user host multi-method method user host
6 "Decoding remote file %s with function %s..." 6 "Decoding remote file %s with function %s..."

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