beta38-pre3 has been uploaded
26 years
SL Baur
SL Baur
Feature freeze for core XEmacs is May 15th, Midnight UT (+0000)/ 7PM
US/Pacific (-0700). Anything not strictly a vital bug fix after that
date will go into XEmacs 21.1. The burning question is, what will
XEmacs/MS Windows be like by then?
Except for MS Windows changes, we are currently in feature slush, and
only smallish new features are being considered.
http://cvs.xemacs.org/
ftp://ftp.xemacs.org/pub/xemacs/beta/testing/
This XEmacs has been de-GIFfed. If you are going to try the patch
(based on vanilla beta37, reverse all patches to beta37 before
attempting to apply it), you will need to download the file
in beta/testing xemacs-gif-to-png.tar, then do from the top-level
XEmacs source directory:
$ rm -f etc/*.gif
$ rm -f etc/custom/*.gif
$ tar xf /tmp/xemacs-gif-to-png.tar
We probably should start thinking about putting up libpng binaries on
ftp.xemacs.org.
It is a good idea to rerun configure from scratch when configuring,
instead of running `./config.status --recheck'.
A note on XEmacs betas and the every-other-day snapshots:
We appreciate all the people who have been diligently testing the
releases. Please don't feel any pressure to attempt to build every
single one of them. No one is expected to build them all.
Cumulative changes from beta37
<Not listed in b38-pre3/CHANGES-beta>
-- print changes/find-file changes from Hrvoje Niksic
-- source formatting changes from Martin Buchholz
</Not listed in b38-pre3/CHANGES-beta>
-- font handling for W3 under MS Windows from Andy Piper
-- Xpm color symbol support for MS Windows from Andy Piper
-- keyboard macro fixes from Hrvoje Niksic
-- MS Windows Signal fix from Kirill Katsnelson
-- All GIFs in core distribution converted to PNGs -- screw Unisys
-- More build tweaks
-- Make line-number-mode/column-number-mode appear in minor mode menu from
Jim Radford
-- General toolbar fixes from Kirill Katsnelson
-- Selection patches from Andy Piper
-- background pixmaps in MS Windows from Andy Piper
-- Startup patches from Michael Sperber
-- Signalling support for MS Windows from Kirill Katsnelson
-- Startup tweaks
-- PNG crash fix from Jareth Hein
-- Keyboard Focus sanity from Greg Klanderman
-- LDAP fixes from Oscar Figueiredo
-- Fix Lisp union type on MS Windows from Andy Piper
-- Miscellaneous patches from Jonathan Harris, Kirill Katsnelson
-- Build clean up
- 1 participants
- 0 comments
Re: select-window focus problem [was: Re: minor compile.el bug]
26 years
Hrvoje Niksic
Hrvoje Niksic
greg(a)alphatech.com (Greg Klanderman) writes:
> OK, this should do it in terms of documentation and fixing C-x 5 o.
Cool, thanks. I'll send a small addition patchlet later. Do you
think we should default focus-follows-mouse to t?
--
Hrvoje Niksic <hniksic(a)srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
Nostalgia isn't what it used to be.
- 1 participants
- 0 comments
Re: format-alist
26 years
Hrvoje Niksic
Hrvoje Niksic
SL Baur <steve(a)xemacs.org> writes:
> Hrvoje Niksic <hniksic(a)srce.hr> writes:
>
> > Could you please return it, or disable the `format' feature
> > altogether? We cannot have things half-implemented like this. :-(
>
> Very well.
Speaking of which, is there a chance we will finally remove image
support from format-alist? I think the whole problem arose when
someone tried `C-x i IMAGE-FILE RET'.
--
Hrvoje Niksic <hniksic(a)srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
Nostalgia isn't what it used to be.
- 1 participants
- 0 comments
Plea for minimal tagbits
26 years
Olivier Galibert
Olivier Galibert
I'd like to see --use-minimal-tagbits being default, and the other
alternative actually removed.
Rationale:
- per Kyle's study, performance is equivalent
- we have to settle on one of the options for code-freezing time in
order to ensure proper testing on all architectures
- not munging pointers is infinitely better because:
* it removes the need for DATA_SEG_BITS which, basically, sucks
* it makes purify-like memory leak detection possible
- it gives us 31bits integers and 30bits characters, and *ensures*
that we have them as soon as version>=21.0
- code in lisp.h becomes cleaner (the less #ifdefs, the better)
What do you think ?
OG.
- 3 participants
- 3 comments
Re: select-window focus problem [was: Re: minor compile.el bug]
26 years
Greg Klanderman
Greg Klanderman
OK, this should do it in terms of documentation and fixing C-x 5 o.
greg
>>>>> "Hrvoje" == Hrvoje Niksic <hniksic(a)srce.hr> writes:
Hrvoje>
Hrvoje> greg(a)alphatech.com (Greg Klanderman) writes:
>> Are we agreed that with f-f-m true, C-x 5 o (other-frame) is the
>> *only* command which should warp focus.
Hrvoje>
Hrvoje> Yes. But this is still a major behavioral change which you should
Hrvoje> document. For instance, it may be worth noting (in the manual) that
Hrvoje> if you want `select-frame' to actually select the WM frame, you must
Hrvoje> bind focus-follows-mouse to nil.
Hrvoje>
Hrvoje> Other than the `C-x 5 o' problem, I must once again state that your
Hrvoje> patch does The Right Thing. For instance,
Hrvoje> (progn (select-frame (other-frame)) (insert "foo")) inserts "foo" in
Hrvoje> the other buffer's frame, which is correct, and then reselects this
Hrvoje> frame for focus. Kudos to you. :-)
1998-04-30 Greg Klanderman <greg(a)alphatech.com>
* frame.el (other-frame): Work even when focus-follows-mouse is true.
1998-04-30 Greg Klanderman <greg(a)alphatech.com>
* frame.c (Fselect_frame): update docstring to describe
focus-follows-mouse behavior.
1998-04-30 Greg Klanderman <greg(a)alphatech.com>
* lispref/frames.texi (Input Focus): Document behavior of
select-frame wrt focus-follows-mouse.
Index: etc/NEWS
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/etc/NEWS,v
retrieving revision 1.48
diff -u -r1.48 NEWS
--- NEWS 1998/04/24 21:33:58 1.48
+++ NEWS 1998/05/01 08:41:08
＠＠ -33,6 +33,17 ＠＠
* Changes in XEmacs 21.0
========================
+** When the variable focus-follows-mouse is non-nil, it is no longer
+possible for select-frame to permanently select a different frame.
+The frame selection is temporary and is reverted when the current
+command terminates, much like the buffer selected by `set-buffer'.
+In order to effect a permanent focus change in this case, bind
+focus-follows-mouse to nil, select the frame you want, and do a
+(sit-for 0) within the scope of the binding. The function
+other-frame (normally bound to C-x 5 o) is the only command provided
+which does not respect the setting of focus-follows-mouse, and *will*
+allow one to select a different frame even when set non-nil.
+
** XEmacs has been unbundled into constituent installable packages.
See the file `etc/PACKAGES' in the distribution for a full
description.
Index: man/lispref/frames.texi
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/man/lispref/frames.texi,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 frames.texi
--- frames.texi 1996/12/18 22:43:49 1.1.1.1
+++ frames.texi 1998/05/01 08:41:09
＠＠ -677,6 +677,13 ＠＠
＠code{deselect-frame-hook} to be run, until the next time that XEmacs is
waiting for an event.
+Also note that when the variable ＠code{focus-follows-mouse} is non-nil,
+the frame selection is temporary and is reverted when the current
+command terminates, much like the buffer selected by ＠code{set-buffer}.
+In order to effect a permanent focus change in this case, bind
+＠code{focus-follows-mouse} to nil, select the frame you want, and do a
+＠code{(sit-for 0)} within the scope of the binding.
+
＠ignore (FSF Emacs)
XEmacs cooperates with the X server and the window managers by arranging
to select frames according to what the server and window manager ask
Index: lisp/frame.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/frame.el,v
retrieving revision 1.11
diff -u -r1.11 frame.el
--- frame.el 1998/04/23 02:07:52 1.11
+++ frame.el 1998/05/01 08:41:10
＠＠ -516,10 +516,15 ＠＠
(defun other-frame (arg)
"Select the ARG'th different visible frame, and raise it.
All frames are arranged in a cyclic order.
-This command selects the frame ARG steps away in that order.
+This command selects the frame ARG steps away in that order,
+regardless of the value of `focus-follows-mouse'.
A negative ARG moves in the opposite order."
(interactive "p")
- (let ((frame (selected-frame)))
+ (let ((frame (selected-frame))
+ ;; Allow selecting another frame even when
+ ;; focus-follows-mouse is true.
+ (focus-policy focus-follows-mouse)
+ (focus-follows-mouse nil))
(while (> arg 0)
(setq frame (next-frame frame 'visible-nomini))
(setq arg (1- arg)))
＠＠ -528,6 +533,8 ＠＠
(setq arg (1+ arg)))
(raise-frame frame)
(select-frame frame)
+ (if focus-policy ;; this hack allows the focus change to be
+ (sit-for 0)) ;; processed while focus-follows-mouse is nil.
;this is a bad idea; you should in general never warp the
;pointer unless the user asks for this. Furthermore,
;our version of `set-mouse-position' takes a window,
Index: src/frame.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/frame.c,v
retrieving revision 1.27
diff -u -r1.27 frame.c
--- frame.c 1998/04/29 23:03:51 1.27
+++ frame.c 1998/05/01 08:41:11
＠＠ -667,6 +667,13 ＠＠
Note that this does not actually cause the window-system focus to
be set to this frame, or the select-frame-hook or deselect-frame-hook
to be run, until the next time that XEmacs is waiting for an event.
+
+Also note that when focus-follows-mouse is non-nil, the frame
+selection is temporary and is reverted when the current command
+terminates, much like the buffer selected by `set-buffer'. In order
+to effect a permanent focus change in this case, bind
+focus-follows-mouse to nil, select the frame you want, and do
+a (sit-for 0) within the scope of the binding.
*/
(frame))
{
- 1 participants
- 0 comments
[PATCH] Update 1998-05-01
26 years
Hrvoje Niksic
Hrvoje Niksic
print.c cleanups + files.el synch with FSF 20.3
C ChangeLog:
1998-05-01 Hrvoje Niksic <hniksic(a)srce.hr>
* print.c (Fwrite_char): Don't touch Vprint_gensym.
(print_error_message): Don't gcpro TAIL.
(Fdisplay_error): Simplify.
1998-04-30 Hrvoje Niksic <hniksic(a)srce.hr>
* print.c (print_internal): Use long_to_string().
* redisplay.c (decode_mode_spec): Remove bogus calculation of the
number of digits.
* print.c (Fprin1): Removed THE_STREAM.
(Fprinc): Ditto.
(Fprint): Ditto.
(Fdisplay_error): Canonicalize STREAM here.
(print_error_message): Don't canonicalize STREAM.
(print_error_message): Use print_internal() instead of Fprin1 and
Fprinc.
* print.c: (Fprin1_to_string): Delete internal stream explicitly.
(Ferror_message_string): Ditto.
(Fterpri): Use write_char_internal.
Lisp ChangeLog:
1998-05-01 Hrvoje Niksic <hniksic(a)srce.hr>
* files.el (find-file-noselect): Update docstring.
(find-file-noselect): Signal an error if found an unreadable file.
(file-chase-links): Save the match data.
(normal-mode): Use `lwarn' and `error-message-string'.
(interpreter-mode-alist): Change defconst to defvar.
(inhibit-first-line-modes-regexps): Ditto.
(inhibit-first-line-modes-regexps): Added .tgz.
(inhibit-first-line-modes-suffixes): Change defconst to defvar.
(change-major-mode-with-file-name): New user-option.
(set-visited-file-name): Synched with FSF.
(file-name-extension): New function, from FSF 20.3.
(file-relative-name): Synched with FSF.
(save-some-buffers): Support the C-r feature.
(recover-session): Synched with FSF.
(kill-some-buffers): Ditto.
(set-auto-mode): New argument JUST-FROM-FILE-NAME.
--- src/print.c.orig Thu Apr 30 21:53:10 1998
+++ src/print.c Fri May 1 00:41:34 1998
＠＠ -45,8 +45,6 ＠＠
#define DBL_DIG 16
#endif
-static void print_error_message (Lisp_Object data, Lisp_Object stream);
-
Lisp_Object Vstandard_output, Qstandard_output;
/* The subroutine object for external-debugging-output is kept here
＠＠ -220,7 +218,7 ＠＠
else if (FRAMEP (function))
{
/* This gets used by functions not invoking print_prepare(),
- such as Fwrite_char. */
+ such as Fwrite_char, Fterpri, etc.. */
struct frame *f = XFRAME (function);
CHECK_LIVE_FRAME (function);
＠＠ -337,21 +335,21 ＠＠
Lstream_delete (str);
}
}
-
-/* Used for printing a character. STRING_OF_LENGTH_1 must contain a
- single-byte character, not just any emchar. */
+
+/* Used for printing a single-byte character (*not* any Emchar). */
#define write_char_internal(string_of_length_1, stream) \
- output_string ((stream), (CONST Bufbyte *) (string_of_length_1), \
+ output_string (stream, (CONST Bufbyte *) (string_of_length_1), \
Qnil, 0, 1)
-/* NOTE: Do not call this with the data of a Lisp_String,
- * as printcharfun might cause a GC, which might cause
- * the string's data to be relocated.
- * Use print_internal (string, printcharfun, 0)
- * to princ a Lisp_String
- * Note: "stream" should be the result of "canonicalize_printcharfun"
- * (ie Qnil means stdout, not Vstandard_output, etc)
- */
+/* NOTE: Do not call this with the data of a Lisp_String, as
+ printcharfun might cause a GC, which might cause the string's data
+ to be relocated. To princ a Lisp string, use:
+
+ print_internal (string, printcharfun, 0);
+
+ Also note that STREAM should be the result of
+ canonicalize_printcharfun() (i.e. Qnil means stdout, not
+ Vstandard_output, etc.) */
void
write_string_1 (CONST Bufbyte *str, Bytecount size, Lisp_Object stream)
{
＠＠ -381,10 +379,8 ＠＠
Bytecount len;
CHECK_CHAR_COERCE_INT (ch);
- RESET_PRINT_GENSYM;
len = set_charptr_emchar (str, XCHAR (ch));
output_string (canonicalize_printcharfun (stream), str, Qnil, 0, len);
- RESET_PRINT_GENSYM;
return ch;
}
＠＠ -478,9 +474,7 ＠＠
(stream))
{
/* This function can GC */
- Bufbyte str[1];
- str[0] = '\n';
- output_string (canonicalize_printcharfun (stream), str, Qnil, 0, 1);
+ write_char_internal ("\n", canonicalize_printcharfun (stream));
return Qt;
}
＠＠ -493,14 +487,15 ＠＠
(object, stream))
{
/* This function can GC */
- Lisp_Object the_stream = Qnil, frame = Qnil;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object frame = Qnil;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (object, stream);
- GCPRO3 (object, stream, the_stream);
print_depth = 0;
- the_stream = print_prepare (stream, &frame);
- print_internal (object, the_stream, 1);
- print_finish (the_stream, frame);
+ stream = print_prepare (stream, &frame);
+ print_internal (object, stream, 1);
+ print_finish (stream, frame);
+
UNGCPRO;
return object;
}
＠＠ -514,23 +509,23 ＠＠
(object, noescape))
{
/* This function can GC */
- Lisp_Object stream;
- Lstream *str;
- struct gcpro gcpro1, gcpro2;
-
- stream = make_resizing_buffer_output_stream ();
- str = XLSTREAM (stream);
+ Lisp_Object result = Qnil;
+ Lisp_Object stream = make_resizing_buffer_output_stream ();
+ Lstream *str = XLSTREAM (stream);
+ /* gcpro OBJECT in case a caller forgot to do so */
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ GCPRO3 (object, stream, result);
- /* Protect OBJECT, in case a caller forgot to protect. */
- GCPRO2 (object, stream);
print_depth = 0;
RESET_PRINT_GENSYM;
print_internal (object, stream, NILP (noescape));
RESET_PRINT_GENSYM;
Lstream_flush (str);
UNGCPRO;
- return make_string (resizing_buffer_stream_ptr (str),
- Lstream_byte_count (str));
+ result = make_string (resizing_buffer_stream_ptr (str),
+ Lstream_byte_count (str));
+ Lstream_delete (str);
+ return result;
}
DEFUN ("princ", Fprinc, 1, 2, 0, /*
＠＠ -539,19 +534,19 ＠＠
the contents of strings.
Output stream is STREAM, or value of standard-output (which see).
*/
- (obj, stream))
+ (object, stream))
{
/* This function can GC */
- Lisp_Object the_stream = Qnil, frame = Qnil;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object frame = Qnil;
+ struct gcpro gcpro1, gcpro2;
- GCPRO3 (obj, stream, the_stream);
- the_stream = print_prepare (stream, &frame);
+ GCPRO2 (object, stream);
+ stream = print_prepare (stream, &frame);
print_depth = 0;
- print_internal (obj, the_stream, 0);
- print_finish (the_stream, frame);
+ print_internal (object, stream, 0);
+ print_finish (stream, frame);
UNGCPRO;
- return obj;
+ return object;
}
DEFUN ("print", Fprint, 1, 2, 0, /*
＠＠ -560,62 +555,40 ＠＠
can handle, whenever this is possible.
Output stream is STREAM, or value of `standard-output' (which see).
*/
- (obj, stream))
+ (object, stream))
{
/* This function can GC */
- Lisp_Object the_stream = Qnil, frame = Qnil;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object frame = Qnil;
+ struct gcpro gcpro1, gcpro2;
- GCPRO3 (obj, stream, the_stream);
- the_stream = print_prepare (stream, &frame);
+ GCPRO2 (object, stream);
+ stream = print_prepare (stream, &frame);
print_depth = 0;
- write_char_internal ("\n", the_stream);
- print_internal (obj, the_stream, 1);
- write_char_internal ("\n", the_stream);
- print_finish (the_stream, frame);
+ write_char_internal ("\n", stream);
+ print_internal (object, stream, 1);
+ write_char_internal ("\n", stream);
+ print_finish (stream, frame);
UNGCPRO;
- return obj;
+ return object;
}
+/* Print an error message for the error DATA to STREAM. This is a
+ complete implementation of `display-error', which used to be in
+ Lisp (see prim/cmdloop.el). It was ported to C so it can be used
+ efficiently by Ferror_message_string. Fdisplay_error and
+ Ferror_message_string are trivial wrappers around this function.
-/* Synched with Emacs 19.34 -- underlying implementation (incarnated
- in print_error_message) is completely divergent, though. */
-DEFUN ("error-message-string", Ferror_message_string, 1, 1, 0, /*
-Convert an error value (ERROR-SYMBOL . DATA) to an error message.
-*/
- (data))
-{
- /* This function can GC */
- Lisp_Object stream = make_resizing_buffer_output_stream ();
- struct gcpro gcpro1;
- GCPRO1 (stream);
-
- print_error_message (data, stream);
- Lstream_flush (XLSTREAM (stream));
- UNGCPRO;
- return make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
- Lstream_byte_count (XLSTREAM (stream)));
-}
-
-/* Print an error message for the error DATA onto Lisp output stream
- STREAM (suitable for the print functions).
-
- This is a complete implementation of `display-error', which used to
- be in Lisp (see prim/cmdloop.el). It was ported to C so we can use
- it in Ferror_message_string. Fdisplay_error and
- Ferror_message_string are trivial wrappers to this function. */
+ STREAM should be the result of canonicalize_printcharfun(). */
static void
print_error_message (Lisp_Object error_object, Lisp_Object stream)
{
/* This function can GC */
- Lisp_Object type;
+ Lisp_Object type = Fcar_safe (error_object);
Lisp_Object method = Qnil;
- Lisp_Object tail = Qnil;
- struct gcpro gcpro1;
+ Lisp_Object tail;
- GCPRO1 (tail);
-
- type = Fcar_safe (error_object);
+ /* No need to GCPRO anything under the assumption that ERROR_OBJECT
+ is GCPRO'd. */
if (! (CONSP (error_object) && SYMBOLP (type)
&& CONSP (Fget (type, Qerror_conditions, Qnil))))
＠＠ -645,44 +618,40 ＠＠
/* Default method */
{
int first = 1;
- Lisp_Object printcharfun = canonicalize_printcharfun (stream);
int speccount = specpdl_depth ();
specbind (Qprint_message_label, Qerror);
tail = Fcdr (error_object);
if (EQ (type, Qerror))
{
- Fprinc (Fcar (tail), stream);
+ print_internal (Fcar (tail), stream, 0);
tail = Fcdr (tail);
}
else
{
Lisp_Object errmsg = Fget (type, Qerror_message, Qnil);
if (NILP (errmsg))
- Fprinc (type, stream);
+ print_internal (type, stream, 0);
else
- Fprinc (errmsg, stream);
+ print_internal (LISP_GETTEXT (errmsg), stream, 0);
}
while (!NILP (tail))
{
- write_c_string (first ? ": " : ", ", printcharfun);
- Fprin1 (Fcar (tail), stream);
+ write_c_string (first ? ": " : ", ", stream);
+ print_internal (Fcar (tail), stream, 1);
tail = Fcdr (tail);
first = 0;
}
unbind_to (speccount, Qnil);
- UNGCPRO;
return;
- /* Unreached */
+ /* not reached */
}
error_throw:
- UNGCPRO;
if (NILP (method))
{
- write_c_string ("Peculiar error ",
- canonicalize_printcharfun (stream));
- Fprin1 (error_object, stream);
+ write_c_string (GETTEXT ("Peculiar error "), stream);
+ print_internal (error_object, stream, 1);
return;
}
else
＠＠ -691,13 +660,38 ＠＠
}
}
+DEFUN ("error-message-string", Ferror_message_string, 1, 1, 0, /*
+Convert ERROR-OBJECT to an error message, and return it.
+
+The format of ERROR-OBJECT should be (ERROR-SYMBOL . DATA). The
+message is equivalent to the one that would be issued by
+`display-error' with the same argument.
+*/
+ (error_object))
+{
+ /* This function can GC */
+ Lisp_Object result = Qnil;
+ Lisp_Object stream = make_resizing_buffer_output_stream ();
+ struct gcpro gcpro1;
+ GCPRO1 (stream);
+
+ print_error_message (error_object, stream);
+ Lstream_flush (XLSTREAM (stream));
+ result = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+ Lstream_byte_count (XLSTREAM (stream)));
+ Lstream_delete (XLSTREAM (stream));
+
+ UNGCPRO;
+ return result;
+}
+
DEFUN ("display-error", Fdisplay_error, 2, 2, 0, /*
-Display an error message for ERROR-OBJECT to STREAM.
+Display ERROR-OBJECT on STREAM in a user-friendly way.
*/
(error_object, stream))
{
/* This function can GC */
- print_error_message (error_object, stream);
+ print_error_message (error_object, canonicalize_printcharfun (stream));
return Qnil;
}
＠＠ -707,8 +701,6 ＠＠
Lisp_Object Vfloat_output_format;
Lisp_Object Qfloat_output_format;
-void
-float_to_string (char *buf, double data)
/*
* This buffer should be at least as large as the max string size of the
* largest float, printed in the biggest notation. This is undoubtably
＠＠ -722,6 +714,8 ＠＠
* re-writing _doprnt to be more sane)?
* -wsr
*/
+void
+float_to_string (char *buf, double data)
{
Bufbyte *cp, c;
int width;
＠＠ -797,12 +791,15 ＠＠
/* Print NUMBER to BUFFER. The digits are first written in reverse
order (the least significant digit first), and are then reversed.
This is equivalent to sprintf(buffer, "%ld", number), only much
- faster. */
+ faster.
+
+ BUFFER should accept 24 bytes. This should suffice for the longest
+ numbers on 64-bit machines. */
void
long_to_string (char *buffer, long number)
{
char *p;
- int i, l;
+ int i, len;
if (number < 0)
{
＠＠ -810,6 +807,7 ＠＠
number = -number;
}
p = buffer;
+
/* Print the digits to the string. */
do
{
＠＠ -817,15 +815,16 ＠＠
number /= 10;
}
while (number);
+
/* And reverse them. */
- l = p - buffer - 1;
- for (i = l/2; i >= 0; i--)
+ len = p - buffer - 1;
+ for (i = len / 2; i >= 0; i--)
{
char c = buffer[i];
- buffer[i] = buffer[l - i];
- buffer[l - i] = c;
+ buffer[i] = buffer[len - i];
+ buffer[len - i] = c;
}
- buffer[l + 1] = '\0';
+ buffer[len + 1] = '\0';
}
static void
＠＠ -877,7 +876,7 ＠＠
{
obj = XCAR (XCDR (obj));
GCPRO2 (obj, printcharfun);
- write_char_internal ("'", printcharfun);
+ write_char_internal ("\'", printcharfun);
UNGCPRO;
print_internal (obj, printcharfun, escapeflag);
return;
＠＠ -885,6 +884,7 ＠＠
GCPRO2 (obj, printcharfun);
write_char_internal ("(", printcharfun);
+
{
int i = 0;
int max = 0;
＠＠ -1028,7 +1028,6 ＠＠
print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
/* This function can GC */
- char buf[256];
QUIT;
＠＠ -1055,13 +1054,14 ＠＠
for (i = 0; i < print_depth; i++)
if (EQ (obj, being_printed[i]))
{
- sprintf (buf, "#%d", i);
+ char buf[32];
+ *buf = '#';
+ long_to_string (buf + 1, i);
write_c_string (buf, printcharfun);
return;
}
}
-
being_printed[print_depth] = obj;
print_depth++;
＠＠ -1077,6 +1077,7 ＠＠
case Lisp_Type_Int:
#endif
{
+ char buf[24];
long_to_string (buf, XINT (obj));
write_c_string (buf, printcharfun);
break;
＠＠ -1085,6 +1086,7 ＠＠
case Lisp_Type_Char:
{
/* God intended that this be #\..., you know. */
+ char buf[16];
Emchar ch = XCHAR (obj);
char *p = buf;
*p++ = '?';
＠＠ -1209,8 +1211,9 ＠＠
default:
{
- /* We're in trouble if this happens!
- Probably should just abort () */
+ char buf[128];
+ /* We're in trouble if this happens! Probably should just
+ abort () */
if (print_readably)
error ("printing illegal data type #o%03o",
(int) XTYPE (obj));
＠＠ -1436,8 +1439,13 ＠＠
}
/* #ifdef DEBUG_XEMACS */
-/* I don't like seeing `Note: Strange doc (not fboundp) for function */
-/* alternate-debugging-output ＠ 429542' -slb */
+
+/* I don't like seeing `Note: Strange doc (not fboundp) for function
+ alternate-debugging-output ＠ 429542' -slb */
+/* #### Eek! Any clue how to get rid of it? In fact, how about
+ getting rid of this function altogether? Does anything actually
+ *use* it? --hniksic */
+
int alternate_do_pointer;
char alternate_do_string[5000];
＠＠ -1462,7 +1470,7 ＠＠
alternate_do_string[alternate_do_pointer] = 0;
return character;
}
-/* #endif /* DEBUG_XEMACS */
+/* #endif / * DEBUG_XEMACS */
DEFUN ("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
Write CHAR-OR-STRING to stderr or stdout.
--- src/redisplay.c.orig Thu Apr 30 22:19:52 1998
+++ src/redisplay.c Thu Apr 30 22:20:45 1998
＠＠ -6319,18 +6319,11 ＠＠
/* print the current column */
case 'c':
{
- int col = current_column (b) + (column_number_start_at_one != 0);
+ int col = current_column (b) + !!column_number_start_at_one;
int temp = col;
int size = 2;
- char *buf;
+ char buf[32];
- while (temp >= 10)
- {
- temp /= 10;
- size++;
- }
-
- buf = alloca_array (char, size);
long_to_string (buf, col);
Dynarr_add_many (mode_spec_bufbyte_string,
--- lisp/files.el.orig Fri May 1 00:57:07 1998
+++ lisp/files.el Fri May 1 02:24:15 1998
＠＠ -23,7 +23,7 ＠＠
;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
-;;; Synched up with: FSF 19.34 [Partial].
+;;; Synched up with: FSF 20.3 (but diverging)
;;; Warning: Merging this file is tough. Beware.
;;; Commentary:
＠＠ -496,85 +496,7 ＠＠
; We have this in C and use the realpath() system call.
;(defun file-truename (filename &optional counter prev-dirs)
-; "Return the truename of FILENAME, which should be absolute.
-;The truename of a file name is found by chasing symbolic links
-;both at the level of the file and at the level of the directories
-;containing it, until no links are left at any level.
-;
-;The arguments COUNTER and PREV-DIRS are used only in recursive calls.
-;Do not specify them in other calls."
-; ;; COUNTER can be a cons cell whose car is the count of how many more links
-; ;; to chase before getting an error.
-; ;; PREV-DIRS can be a cons cell whose car is an alist
-; ;; of truenames we've just recently computed.
-; ;; The last test looks dubious, maybe `+' is meant here? --simon.
-; (if (or (string= filename "") (string= filename "~")
-; (and (string= (substring filename 0 1) "~")
-; (string-match "~[^/]*" filename)))
-; (progn
-; (setq filename (expand-file-name filename))
-; (if (string= filename "")
-; (setq filename "/"))))
-; (or counter (setq counter (list 100)))
-; (let (done
-; ;; For speed, remove the ange-ftp completion handler from the list.
-; ;; We know it's not needed here.
-; ;; For even more speed, do this only on the outermost call.
-; (file-name-handler-alist
-; (if prev-dirs file-name-handler-alist
-; (let ((tem (copy-sequence file-name-handler-alist)))
-; (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
-; (or prev-dirs (setq prev-dirs (list nil)))
-; ;; If this file directly leads to a link, process that iteratively
-; ;; so that we don't use lots of stack.
-; (while (not done)
-; (setcar counter (1- (car counter)))
-; (if (< (car counter) 0)
-; (error "Apparent cycle of symbolic links for %s" filename))
-; (let ((handler (find-file-name-handler filename 'file-truename)))
-; ;; For file name that has a special handler, call handler.
-; ;; This is so that ange-ftp can save time by doing a no-op.
-; (if handler
-; (setq filename (funcall handler 'file-truename filename)
-; done t)
-; (let ((dir (or (file-name-directory filename) default-directory))
-; target dirfile)
-; ;; Get the truename of the directory.
-; (setq dirfile (directory-file-name dir))
-; ;; If these are equal, we have the (or a) root directory.
-; (or (string= dir dirfile)
-; ;; If this is the same dir we last got the truename for,
-; ;; save time--don't recalculate.
-; (if (assoc dir (car prev-dirs))
-; (setq dir (cdr (assoc dir (car prev-dirs))))
-; (let ((old dir)
-; (new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
-; (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
-; (setq dir new))))
-; (if (equal ".." (file-name-nondirectory filename))
-; (setq filename
-; (directory-file-name (file-name-directory (directory-file-name dir)))
-; done t)
-; (if (equal "." (file-name-nondirectory filename))
-; (setq filename (directory-file-name dir)
-; done t)
-; ;; Put it back on the file name.
-; (setq filename (concat dir (file-name-nondirectory filename)))
-; ;; Is the file name the name of a link?
-; (setq target (file-symlink-p filename))
-; (if target
-; ;; Yes => chase that link, then start all over
-; ;; since the link may point to a directory name that uses links.
-; ;; We can't safely use expand-file-name here
-; ;; since target might look like foo/../bar where foo
-; ;; is itself a link. Instead, we handle . and .. above.
-; (setq filename
-; (if (file-name-absolute-p target)
-; target
-; (concat dir target))
-; done nil)
-; ;; No, we are done!
-; (setq done t))))))))
+; [... lots of code snipped ...]
; filename))
;; XEmacs addition. Called from `insert-file-contents-internal'
＠＠ -610,28 +532,29 ＠＠
unlike `file-truename'."
(let (tem (count 100) (newname filename))
(while (setq tem (file-symlink-p newname))
- (if (= count 0)
- (error "Apparent cycle of symbolic links for %s" filename))
- ;; In the context of a link, `//' doesn't mean what XEmacs thinks.
- (while (string-match "//+" tem)
- (setq tem (concat (substring tem 0 (1+ (match-beginning 0)))
- (substring tem (match-end 0)))))
- ;; Handle `..' by hand, since it needs to work in the
- ;; target of any directory symlink.
- ;; This code is not quite complete; it does not handle
- ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
- (while (string-match "\\`\\.\\./" tem) ;#### Unix specific
- (setq tem (substring tem 3))
- (setq newname (file-name-as-directory
- ;; Do the .. by hand.
- (directory-file-name
- (file-name-directory
- ;; Chase links in the default dir of the symlink.
- (file-chase-links
- (directory-file-name
- (file-name-directory newname))))))))
- (setq newname (expand-file-name tem (file-name-directory newname)))
- (setq count (1- count)))
+ (save-match-data
+ (if (= count 0)
+ (error "Apparent cycle of symbolic links for %s" filename))
+ ;; In the context of a link, `//' doesn't mean what XEmacs thinks.
+ (while (string-match "//+" tem)
+ (setq tem (concat (substring tem 0 (1+ (match-beginning 0)))
+ (substring tem (match-end 0)))))
+ ;; Handle `..' by hand, since it needs to work in the
+ ;; target of any directory symlink.
+ ;; This code is not quite complete; it does not handle
+ ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
+ (while (string-match "\\`\\.\\./" tem) ;#### Unix specific
+ (setq tem (substring tem 3))
+ (setq newname (file-name-as-directory
+ ;; Do the .. by hand.
+ (directory-file-name
+ (file-name-directory
+ ;; Chase links in the default dir of the symlink.
+ (file-chase-links
+ (directory-file-name
+ (file-name-directory newname))))))))
+ (setq newname (expand-file-name tem (file-name-directory newname)))
+ (setq count (1- count))))
newname))
(defun switch-to-other-buffer (arg)
＠＠ -913,6 +836,7 ＠＠
;; This function is needed by FSF vc.el. I hope somebody can make it
;; work for XEmacs. -sb.
+;; #### In what way does it not work? --hniksic
(defun find-buffer-visiting (filename)
"Return the buffer visiting file FILENAME (a string).
This is like `get-file-buffer', except that it checks for any buffer
＠＠ -974,20 +898,18 ＠＠
If a buffer exists visiting FILENAME, return that one, but
verify that the file has not changed since visited or saved.
The buffer is not selected, just returned to the caller.
-If NOWARN is non-nil, warning messages about several potential
-problems will be suppressed."
+If NOWARN is non-nil, warning messages will be suppressed.
+If RAWFILE is non-nil, the file is read literally."
(setq filename (abbreviate-file-name (expand-file-name filename)))
(if (file-directory-p filename)
(if (and (fboundp 'dired-noselect) find-file-run-dired)
(dired-noselect (if find-file-use-truenames
(abbreviate-file-name (file-truename filename))
filename))
- (error "%s is a directory." filename))
+ (error "%s is a directory" filename))
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
- (number (nthcdr 10 (file-attributes (file-truename filename))))
-; (number (and buffer-file-truename
-; (nthcdr 10 (file-attributes buffer-file-truename))))
+ (number (nthcdr 10 (file-attributes truename)))
; ;; Find any buffer for a file which has same truename.
; (other (and (not buf) (find-buffer-visiting filename)))
(error nil))
＠＠ -1022,10 +944,9 ＠＠
;; Certain files should be reverted automatically
;; if they have changed on disk and not in the buffer.
((and (not (buffer-modified-p buf))
- (let (found)
- (dolist (rx revert-without-query found)
- (when (string-match rx filename)
- (setq found t)))))
+ (dolist (rx revert-without-query nil)
+ (when (string-match rx filename)
+ (return t))))
(with-current-buffer buf
(message "Reverting file %s..." filename)
(revert-buffer t t)
＠＠ -1044,8 +965,7 ＠＠
(gettext "File %s changed on disk. Reread from disk into %s? "))
(file-name-nondirectory filename)
(buffer-name buf))))
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(revert-buffer t t)))))
;; Else: we must create a new buffer for filename
(save-excursion
＠＠ -1064,15 +984,23 ＠＠
(condition-case ()
(insert-file-contents-literally filename t)
(file-error
+ (when (and (file-exists-p filename)
+ (not (file-readable-p filename)))
+ (kill-buffer buf)
+ (signal 'file-error (list "File is not readable" filename)))
;; Unconditionally set error
(setq error t)))
- (condition-case e
+ (condition-case ()
(insert-file-contents filename t)
(file-error
+ (when (and (file-exists-p filename)
+ (not (file-readable-p filename)))
+ (kill-buffer buf)
+ (signal 'file-error (list "File is not readable" filename)))
;; Run find-file-not-found-hooks until one returns non-nil.
(or (run-hook-with-args-until-success 'find-file-not-found-hooks)
;; If they fail too, set error.
- (setq error e)))))
+ (setq error t)))))
;; Find the file's truename, and maybe use that as visited name.
;; automatically computed in XEmacs, unless jka-compr was used!
(unless buffer-file-truename
＠＠ -1087,10 +1015,6 ＠＠
0 (match-beginning 0))))
(not (member logical find-file-not-true-dirname-list)))
(setq buffer-file-name buffer-file-truename))
-; (if find-file-visit-truename
-; (setq buffer-file-name
-; (setq filename
-; (expand-file-name buffer-file-truename))))
(and find-file-use-truenames
;; This should be in C. Put pathname abbreviations that have
;; been explicitly requested back into the pathname. Most
＠＠ -1106,11 +1030,16 ＠＠
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t)))
(if rawfile
+ ;; #### FSF 20.3 sets buffer-file-coding-system to
+ ;; `no-conversion' here. Should we copy? It also makes
+ ;; `find-file-literally' a local variable and sets it to t.
nil
(after-find-file error (not nowarn))
(setq buf (current-buffer)))))
buf)))
+;; FSF has `insert-file-literally' and `find-file-literally' here.
+
(defvar after-find-file-from-revert-buffer nil)
(defun after-find-file (&optional error warn noauto
＠＠ -1195,8 +1124,9 ＠＠
nil))
(condition-case err
(hack-local-variables (not find-file))
- (error (message "File local-variables error: %s"
- (prin1-to-string err))))))
+ (error (lwarn 'local-variables 'warning
+ "File local-variables error: %s"
+ (error-message-string err))))))
(defvar auto-mode-alist
'(("\\.te?xt\\'" . text-mode)
＠＠ -1288,7 +1218,7 ＠＠
calling FUNCTION (if it's not nil), we delete the suffix that matched
REGEXP and search the list again for another match.")
-(defconst interpreter-mode-alist
+(defvar interpreter-mode-alist
'(("^#!.*csh" . sh-mode)
("^#!.*sh\\b" . sh-mode)
("^#!.*\\b\\(scope\\|wish\\|tcl\\|expect\\)" . tcl-mode)
＠＠ -1312,10 +1242,10 ＠＠
with the name of the interpreter specified in the first line.
If it matches, mode MODE is selected.")
-(defconst inhibit-first-line-modes-regexps (purecopy '("\\.tar\\'"))
+(defvar inhibit-first-line-modes-regexps (purecopy '("\\.tar\\'" "\\.tgz\\'"))
"List of regexps; if one matches a file name, don't look for `-*-'.")
-(defconst inhibit-first-line-modes-suffixes nil
+(defvar inhibit-first-line-modes-suffixes nil
"List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
When checking `inhibit-first-line-modes-regexps', we first discard
from the end of the file name anything that matches one of these regexps.")
＠＠ -1324,7 +1254,7 ＠＠
"" ; set by command-line
"File name including directory of user's initialization file.")
-(defun set-auto-mode ()
+(defun set-auto-mode (&optional just-from-file-name)
"Select major mode appropriate for current buffer.
This checks for a -*- mode tag in the buffer's text,
compares the filename against the entries in `auto-mode-alist',
＠＠ -1335,7 +1265,11 ＠＠
Local Variables section of the file; for that, use `hack-local-variables'.
If `enable-local-variables' is nil, this function does not check for a
--*- mode tag."
+-*- mode tag.
+
+If the optional argument JUST-FROM-FILE-NAME is non-nil,
+then we do not set anything but the major mode,
+and we don't even do that unless it would come from the file name."
(save-excursion
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
;; Do this by calling the hack-local-variables helper to avoid redundancy.
＠＠ -1370,24 +1304,25 ＠＠
(setq mode (cdr (car alist))
keep-going nil)))
(setq alist (cdr alist))))
- ;; If we can't deduce a mode from the file name,
- ;; look for an interpreter specified in the first line.
- (if (and (null mode)
- (save-excursion ; XEmacs
- (goto-char (point-min))
- (looking-at "#!")))
- (let ((firstline
- (buffer-substring
- (point-min)
- (save-excursion
- (goto-char (point-min)) (end-of-line) (point)))))
- (setq alist interpreter-mode-alist)
- (while alist
- (if (string-match (car (car alist)) firstline)
- (progn
- (setq mode (cdr (car alist)))
- (setq alist nil))
- (setq alist (cdr alist))))))
+ (unless just-from-file-name
+ ;; If we can't deduce a mode from the file name,
+ ;; look for an interpreter specified in the first line.
+ (if (and (null mode)
+ (save-excursion ; XEmacs
+ (goto-char (point-min))
+ (looking-at "#!")))
+ (let ((firstline
+ (buffer-substring
+ (point-min)
+ (save-excursion
+ (goto-char (point-min)) (end-of-line) (point)))))
+ (setq alist interpreter-mode-alist)
+ (while alist
+ (if (string-match (car (car alist)) firstline)
+ (progn
+ (setq mode (cdr (car alist)))
+ (setq alist nil))
+ (setq alist (cdr alist)))))))
(if mode
(if (not (fboundp mode))
(progn
＠＠ -1401,8 +1336,13 ＠＠
(message "Mode %s either doesn't exist or is not a known package" mode))
(sit-for 2)
(error "%s" mode)))
- (funcall mode)))
- ))))))
+ (unless (and just-from-file-name
+ (or
+ ;; Don't reinvoke major mode.
+ (eq mode major-mode)
+ ;; Don't lose on minor modes.
+ (assq mode minor-mode-alist)))
+ (funcall mode))))))))))
(defvar hack-local-variables-hook nil
"Normal hook run after processing a file's local variables specs.
＠＠ -1718,12 +1658,28 ＠＠
(t (make-local-variable var)
(set var val))))
-(defun set-visited-file-name (filename)
+(defcustom change-major-mode-with-file-name t
+ "*Non-nil means \\[write-file] should set the major mode from the file name.
+However, the mode will not be changed if
+\(1) a local variables list or the `-*-' line specifies a major mode, or
+\(2) the current major mode is a \"special\" mode,
+\ not suitable for ordinary files, or
+\(3) the new file name does not particularly specify any mode."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defun set-visited-file-name (filename &optional no-query along-with-file)
"Change name of file visited in current buffer to FILENAME.
The next time the buffer is saved it will go in the newly specified file.
nil or empty string as argument means make buffer not be visiting any file.
Remember to delete the initial contents of the minibuffer
-if you wish to pass an empty string as the argument."
+if you wish to pass an empty string as the argument.
+
+The optional second argument NO-QUERY, if non-nil, inhibits asking for
+confirmation in the case where another buffer is already visiting FILENAME.
+
+The optional third argument ALONG-WITH-FILE, if non-nil, means that
+the old visited file has been renamed to the new name FILENAME."
(interactive "FSet visited file name: ")
(if (buffer-base-buffer)
(error "An indirect buffer cannot visit a file"))
＠＠ -1739,6 +1695,12 ＠＠
;; #### Do we need to check if truename is non-nil?
(if find-file-use-truenames
(setq filename truename))))
+ (let ((buffer (and filename (find-buffer-visiting filename))))
+ (and buffer (not (eq buffer (current-buffer)))
+ (not no-query)
+ (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
+ filename)))
+ (error "Aborted")))
(or (equal filename buffer-file-name)
(progn
(and filename (lock-buffer filename))
＠＠ -1754,7 +1716,8 ＠＠
(or (string= new-name (buffer-name))
(rename-buffer new-name t))))
(setq buffer-backed-up nil)
- (clear-visited-file-modtime)
+ (or along-with-file
+ (clear-visited-file-modtime))
(compute-buffer-file-truename) ; insert-file-contents does this too.
; ;; Abbreviate the file names of the buffer.
; (if truename
＠＠ -1777,12 +1740,14 ＠＠
(kill-local-variable 'backup-inhibited)
;; If buffer was read-only because of version control,
;; that reason is gone now, so make it writable.
- (if (and (boundp 'vc-mode) vc-mode)
- (setq buffer-read-only nil))
- (kill-local-variable 'vc-mode)
+ (when (boundp 'vc-mode)
+ (if vc-mode
+ (setq buffer-read-only nil))
+ (kill-local-variable 'vc-mode))
;; Turn off backup files for certain file names.
;; Since this is a permanent local, the major mode won't eliminate it.
- (and (not (funcall backup-enable-predicate buffer-file-name))
+ (and buffer-file-name
+ (not (funcall backup-enable-predicate buffer-file-name))
(progn
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t)))
＠＠ -1803,7 +1768,17 ＠＠
(file-exists-p oauto)
(rename-file oauto buffer-auto-save-file-name t)))
(if buffer-file-name
+ (not along-with-file)
(set-buffer-modified-p t))
+ ;; Update the major mode, if the file name determines it.
+ (condition-case nil
+ ;; Don't change the mode if it is special.
+ (or (not change-major-mode-with-file-name)
+ (get major-mode 'mode-class)
+ ;; Don't change the mode if the local variable list specifies it.
+ (hack-local-variables t)
+ (set-auto-mode t))
+ (error nil))
;; #### ??
(run-hooks 'after-set-visited-file-name-hooks))
＠＠ -1994,6 +1969,22 ＠＠
(substring file 0 (match-beginning 0)))
filename))))
+(defun file-name-extension (filename &optional period)
+ "Return FILENAME's final \"extension\".
+The extension, in a file name, is the part that follows the last `.'.
+Return nil for extensionless file names such as `foo'.
+Return the empty string for file names such as `foo.'.
+
+If PERIOD is non-nil, then the returned value includes the period
+that delimits the extension, and if FILENAME has no extension,
+the value is \"\"."
+ (save-match-data
+ (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
+ (if (string-match "\\.[^.]*\\'" file)
+ (substring file (+ (match-beginning 0) (if period 0 1)))
+ (if period
+ "")))))
+
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
This is a separate function so you can redefine it for customization."
＠＠ -2081,15 +2072,43 ＠＠
(car (cdr (file-attributes filename))))
(defun file-relative-name (filename &optional directory)
- "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
- (setq filename (expand-file-name filename)
- directory (file-name-as-directory (expand-file-name
- (or directory default-directory))))
- (let ((ancestor ""))
- (while (not (string-match (concat "^" (regexp-quote directory)) filename))
- (setq directory (file-name-directory (substring directory 0 -1))
- ancestor (concat "../" ancestor)))
- (concat ancestor (substring filename (match-end 0)))))
+ "Convert FILENAME to be relative to DIRECTORY (default: default-directory).1
+This function returns a relative file name which is equivalent to FILENAME
+when used with that default directory as the default.
+If this is impossible (which can happen on MSDOS and Windows
+when the file name and directory use different drive names)
+then it returns FILENAME."
+ (save-match-data
+ (let ((fname (expand-file-name filename)))
+ (setq directory (file-name-as-directory
+ (expand-file-name (or directory default-directory))))
+ ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
+ ;; drive names, they can't be relative, so return the absolute name.
+ (if (and (or (eq system-type 'ms-dos)
+ (eq system-type 'windows-nt))
+ (not (string-equal (substring fname 0 2)
+ (substring directory 0 2))))
+ filename
+ (let ((ancestor ".")
+ (fname-dir (file-name-as-directory fname)))
+ (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
+ (not (string-match (concat "^" (regexp-quote directory)) fname)))
+ (setq directory (file-name-directory (substring directory 0 -1))
+ ancestor (if (equal ancestor ".")
+ ".."
+ (concat "../" ancestor))))
+ ;; Now ancestor is empty, or .., or ../.., etc.
+ (if (string-match (concat "^" (regexp-quote directory)) fname)
+ ;; We matched within FNAME's directory part.
+ ;; Add the rest of FNAME onto ANCESTOR.
+ (let ((rest (substring fname (match-end 0))))
+ (if (and (equal ancestor ".")
+ (not (equal rest "")))
+ ;; But don't bother with ANCESTOR if it would give us `./'.
+ rest
+ (concat (file-name-as-directory ancestor) rest)))
+ ;; We matched FNAME's directory equivalent.
+ ancestor))))))
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.
＠＠ -2419,16 +2438,20 ＠＠
;; (it makes the dialog box too big, and you get an error
;; "wrong type argument: framep, nil" when you hit q after
;; choosing the option from the dialog box)
-; (list (list ?\C-r (lambda (buf)
-; (view-buffer buf)
-; (setq view-exit-action
-; '(lambda (ignore)
-; (exit-recursive-edit)))
-; (recursive-edit)
-; ;; Return nil to ask about BUF again.
-; nil)
-; "display the current buffer"))
- ))
+
+ ;; We should fix the dialog box rather than disabling
+ ;; this! --hniksic
+ (list (list ?\C-r (lambda (buf)
+ ;; FSF has an EXIT-ACTION argument to
+ ;; `view-buffer'.
+ (view-buffer buf)
+ (setq view-exit-action
+ (lambda (ignore)
+ (exit-recursive-edit)))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "display the current buffer"))))
(abbrevs-done
(and save-abbrevs abbrevs-changed
(progn
＠＠ -2623,10 +2646,11 ＠＠
the files modes. Normally we reinitialize them using `normal-mode'.
If the value of `revert-buffer-function' is non-nil, it is called to
-do the work.
+do all the work for this command. Otherwise, the hooks
+`before-revert-hook' and `after-revert-hook' are run at the beginning
+and the end, and if `revert-buffer-insert-file-contents-function' is
+non-nil, it is called instead of rereading visited file contents."
-The default revert function runs the hook `before-revert-hook' at the
-beginning and `after-revert-hook' at the end."
;; I admit it's odd to reverse the sense of the prefix argument, but
;; there is a lot of code out there which assumes that the first
;; argument should be t to avoid consulting the auto-save file, and
＠＠ -2752,6 +2776,9 ＠＠
(interactive)
(unless (fboundp 'dired)
(error "recover-session requires dired"))
+ (if (null auto-save-list-file-prefix)
+ (error
+ "You set `auto-save-list-file-prefix' to disable making session files"))
(dired (concat auto-save-list-file-prefix "*"))
(goto-char (point-min))
(or (looking-at "Move to the session you want to recover,")
＠＠ -2839,23 +2866,25 ＠＠
(message "No files can be recovered from this session now")))
(kill-buffer buffer))))
-(defun kill-some-buffers ()
- "For each buffer, ask whether to kill it."
+(defun kill-some-buffers (&optional list)
+ "For each buffer in LIST, ask whether to kill it.
+LIST defaults to all existing live buffers."
(interactive)
- (let ((list (buffer-list)))
- (while list
- (let* ((buffer (car list))
- (name (buffer-name buffer)))
- (and (not (string-equal name ""))
- (/= (aref name 0) ? )
- (yes-or-no-p
- (format
- (if (buffer-modified-p buffer)
- (gettext "Buffer %s HAS BEEN EDITED. Kill? ")
- (gettext "Buffer %s is unmodified. Kill? "))
- name))
- (kill-buffer buffer)))
- (setq list (cdr list)))))
+ (if (null list)
+ (setq list (buffer-list)))
+ (while list
+ (let* ((buffer (car list))
+ (name (buffer-name buffer)))
+ (and (not (string-equal name ""))
+ (/= (aref name 0) ?\ )
+ (yes-or-no-p
+ (format
+ (if (buffer-modified-p buffer)
+ (gettext "Buffer %s HAS BEEN EDITED. Kill? ")
+ (gettext "Buffer %s is unmodified. Kill? "))
+ name))
+ (kill-buffer buffer)))
+ (setq list (cdr list))))
(defun auto-save-mode (arg)
"Toggle auto-saving of contents of current buffer.
＠＠ -3226,5 +3255,7 ＠＠
((featurep 'ange-ftp) (ange-ftp-ftp-path file-name))
((fboundp 'efs-ftp-path) (efs-ftp-path file-name))
(t nil)))
+
+;; #### FSF has file-name-non-special here.
;;; files.el ends here
--
Hrvoje Niksic <hniksic(a)srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
Personifiers Unite! You have nothing to lose but Mr. Dignity!
- 1 participants
- 0 comments
Re: format-alist
26 years
SL Baur
SL Baur
Hrvoje Niksic <hniksic(a)srce.hr> writes:
> Could you please return it, or disable the `format' feature
> altogether? We cannot have things half-implemented like this. :-(
Very well.
1998-04-30 SL Baur <steve(a)altair.xemacs.org>
* files.el (insert-file): Undo previous change and reenable use of
format.el.
Index: lisp/files.el
===================================================================
RCS file: /usr/local/xemacs/xemacs-20.0/lisp/files.el,v
retrieving revision 1.18
diff -u -r1.18 files.el
--- lisp/files.el 1998/04/17 05:41:22 1.18
+++ lisp/files.el 1998/05/01 00:33:36
＠＠ -2480,8 +2480,7 ＠＠
(if (file-directory-p filename)
(signal 'file-error (list "Opening input file" "file is a directory"
filename)))
- (let* (format-alist ; format.el only confuses people in this context
- (tem
+ (let ((tem
(if codesys
(let ((coding-system-for-read
(get-coding-system codesys)))
- 1 participants
- 0 comments
Re: format-alist
26 years
Hrvoje Niksic
Hrvoje Niksic
SL Baur <steve(a)xemacs.org> writes:
> Hrvoje Niksic <hniksic(a)srce.hr> writes:
>
> > Why does insert-file bind format-alist to nil? It breaks the
> > `format' feature!
>
> An XEmacs developer complained loudly about it last December.
Could you please return it, or disable the `format' feature
altogether? We cannot have things half-implemented like this. :-(
--
Hrvoje Niksic <hniksic(a)srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
I'm a Lisp variable -- bind me!
- 1 participants
- 0 comments
format-alist
26 years
Hrvoje Niksic
Hrvoje Niksic
Why does insert-file bind format-alist to nil? It breaks the `format'
feature!
--
Hrvoje Niksic <hniksic(a)srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
Personifiers Unite! You have nothing to lose but Mr. Dignity!
- 1 participants
- 0 comments
Re: format-alist
26 years
SL Baur
SL Baur
Hrvoje Niksic <hniksic(a)srce.hr> writes:
> Why does insert-file bind format-alist to nil? It breaks the `format'
> feature!
An XEmacs developer complained loudly about it last December.
- 1 participants
- 0 comments