At 03:49 PM 2/23/01 +0000, Philip Aston wrote: I fixed this a while ago - and it works for me with the latest cygwin snapshot. Make sure you have win32 and mingw installed. Also make sure you have rerun configure. I've sometimes seen this. Killing and restarting seems to cure :) andy

hi, this is just totally shooting off a random shot, but awhile ago when i switched Extbyte to be char instead of unsigned char in my local system, i discovered two bugs that caused crashes. recently, Martin went ahead and made the switch on his own in the tree, and he fixed one but not the other. this second bug fix may have been a crash under cygwin [probably with mule], so there's a remote possibility it will fix your problem. [in any case, it will go in in a few days. i'm working on it.] try it point; it's attached. Philip Aston wrote: -- ben I'm sometimes slow in getting around to reading my mail, so if you want to reach me faster, call 520-661-6661. See http://www.666.com/ben/chronic-pain/ for the hell I've been through. lisp/ChangeLog: ＠＠ -1,3 1,8 ＠＠ 2001-02-03 Ben Wing <ben(a)xemacs.org&gt; * lisp-mode.el (construct-lisp-mode-menu): Add new entry, "Uncomment Region" (parallels "Comment Out Region"). lib-src/ChangeLog: ＠＠ -1,3 1,8 ＠＠ 2000-08-10 Ben Wing <ben(a)xemacs.org&gt; * update-elc.sh: deleted (retroactively). replaced by update-elc-2.el, which does the same thing but in a platform-independent way. Index: src/events-mod.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/events-mod.h,v retrieving revision 1.2.2.2 diff -u -w -r1.2.2.2 events-mod.h --- events-mod.h 2000/07/21 10:16:05 1.2.2.2 +++ events-mod.h 2001/02/24 00:34:39 ＠＠ -1,13 +0,0 ＠＠ -/* The modifiers XEmacs knows about; these appear in key and button events. */ - -#define XEMACS_MOD_CONTROL (1<<0) -#define XEMACS_MOD_META (1<<1) -#define XEMACS_MOD_SUPER (1<<2) -#define XEMACS_MOD_HYPER (1<<3) -#define XEMACS_MOD_ALT (1<<4) -#define XEMACS_MOD_SHIFT (1<<5) /* not used for dual-case characters */ -#define XEMACS_MOD_BUTTON1 (1<<6) -#define XEMACS_MOD_BUTTON2 (1<<7) -#define XEMACS_MOD_BUTTON3 (1<<8) -#define XEMACS_MOD_BUTTON4 (1<<9) -#define XEMACS_MOD_BUTTON5 (1<<10) Index: src/event-Xt.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-Xt.c,v retrieving revision 1.41.2.40 diff -u -w -r1.41.2.40 event-Xt.c --- event-Xt.c 2001/01/28 06:56:05 1.41.2.40 +++ event-Xt.c 2001/02/24 00:34:40 ＠＠ -65,8 +65,6 ＠＠ #include "offix.h" #endif -#include "events-mod.h" - static void handle_focus_event_1 (struct frame *f, int in_p); static struct event_stream *Xt_event_stream; Index: src/event-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-msw.c,v retrieving revision 1.38.2.64 diff -u -w -r1.38.2.64 event-msw.c --- event-msw.c 2001/01/28 06:56:05 1.38.2.64 +++ event-msw.c 2001/02/24 00:34:42 ＠＠ -65,7 +65,6 ＠＠ #include "sysdep.h" #include "objects-msw.h" -#include "events-mod.h" #ifdef HAVE_MSG_SELECT #include "sysfile.h" #include "console-tty.h" Index: src/event-stream.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-stream.c,v retrieving revision 1.45.2.40 diff -u -w -r1.45.2.40 event-stream.c --- event-stream.c 2001/01/28 06:56:06 1.45.2.40 +++ event-stream.c 2001/02/24 00:34:43 ＠＠ -92,7 +92,6 ＠＠ #include "sysfile.h" #include "systime.h" /* to set Vlast_input_time */ -#include "events-mod.h" #ifdef FILE_CODING #include "file-coding.h" #endif Index: src/events.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/events.c,v retrieving revision 1.41.2.22 diff -u -w -r1.41.2.22 events.c --- events.c 2000/11/06 05:43:17 1.41.2.22 +++ events.c 2001/02/24 00:34:44 ＠＠ -37,7 +37,6 ＠＠ #include "keymap.h" /* for key_desc_list_to_event() */ #include "redisplay.h" #include "window.h" -#include "events-mod.h" /* Where old events go when they are explicitly deallocated. The event chain here is cut loose before GC, so these will be freed Index: src/events.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/events.h,v retrieving revision 1.20.2.12 diff -u -w -r1.20.2.12 events.h --- events.h 2000/11/07 08:20:44 1.20.2.12 +++ events.h 2001/02/24 00:34:44 ＠＠ -535,9 +535,23 ＠＠ extern Lisp_Object Qcancel_mode_internal; extern Lisp_Object Vmodifier_keys_sticky_time; -/* Note: under X Windows, XEMACS_MOD_ALT is generated by the Alt key if there are - both Alt and Meta keys. If there are no Meta keys, then Alt generates - XEMACS_MOD_META instead. +/* The modifiers XEmacs knows about; these appear in key and button events. */ + +#define XEMACS_MOD_CONTROL (1<<0) +#define XEMACS_MOD_META (1<<1) +#define XEMACS_MOD_SUPER (1<<2) +#define XEMACS_MOD_HYPER (1<<3) +#define XEMACS_MOD_ALT (1<<4) +#define XEMACS_MOD_SHIFT (1<<5) /* not used for dual-case characters */ +#define XEMACS_MOD_BUTTON1 (1<<6) +#define XEMACS_MOD_BUTTON2 (1<<7) +#define XEMACS_MOD_BUTTON3 (1<<8) +#define XEMACS_MOD_BUTTON4 (1<<9) +#define XEMACS_MOD_BUTTON5 (1<<10) + +/* Note: under X Windows, XEMACS_MOD_ALT is generated by the Alt key + if there are both Alt and Meta keys. If there are no Meta keys, + then Alt generates XEMACS_MOD_META instead. */ #ifdef emacs Index: src/frame-x.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/frame-x.c,v retrieving revision 1.41.2.20 diff -u -w -r1.41.2.20 frame-x.c --- frame-x.c 2001/01/02 22:23:30 1.41.2.20 +++ frame-x.c 2001/02/24 00:34:45 ＠＠ -61,9 +61,6 ＠＠ #ifdef HAVE_OFFIX_DND #include "offix.h" #endif -#if defined (HAVE_OFFIX_DND) || defined (HAVE_CDE) -#include "events-mod.h" -#endif /* Default properties to use when creating frames. */ Lisp_Object Vdefault_x_frame_plist; Index: src/glyphs-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs-msw.c,v retrieving revision 1.21.2.69 diff -u -w -r1.21.2.69 glyphs-msw.c --- glyphs-msw.c 2001/01/17 21:54:18 1.21.2.69 +++ glyphs-msw.c 2001/02/24 00:34:46 ＠＠ -1250,7 +1250,8 ＠＠ } static void -mswindows_resource_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_resource_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { ＠＠ -1988,7 +1989,8 ＠＠ #undef SYSV32 static void -mswindows_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_xface_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { ＠＠ -2376,8 +2378,10 ＠＠ } static void -mswindows_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, +mswindows_subwindow_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); ＠＠ -2496,7 +2500,8 ＠＠ /* widgets */ /************************************************************************/ static void -mswindows_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_widget_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain, const char* class, int flags, int exflags) ＠＠ -2587,7 +2592,8 ＠＠ static void mswindows_native_layout_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); ＠＠ -2612,7 +2618,8 ＠＠ many-to-one relationship with things you see, whereas widgets can only be one-to-one (i.e. per frame) */ static void -mswindows_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_button_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { ＠＠ -2697,8 +2704,10 ＠＠ /* instantiate an edit control */ static void -mswindows_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, +mswindows_edit_field_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, ＠＠ -2709,8 +2718,10 ＠＠ /* instantiate a progress gauge */ static void -mswindows_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, +mswindows_progress_gauge_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { HWND wnd; ＠＠ -2721,17 +2732,15 ＠＠ WS_BORDER | PBS_SMOOTH, WS_EX_CLIENTEDGE); wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); /* set the colors */ -#ifdef PBS_SETBKCOLOR - SendMessage (wnd, PBS_SETBKCOLOR, 0, +#if 0 /* #### fix this */ + SendMessage (wnd, PBM_SETBKCOLOR, 0, (LPARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (FACE_BACKGROUND (XIMAGE_INSTANCE_WIDGET_FACE (ii), XIMAGE_INSTANCE_FRAME (ii)))))); -#endif -#ifdef PBS_SETBARCOLOR - SendMessage (wnd, PBS_SETBARCOLOR, 0, - (L:PARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR + SendMessage (wnd, PBM_SETBARCOLOR, 0, + (LPARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (FACE_FOREGROUND (XIMAGE_INSTANCE_WIDGET_FACE (ii), ＠＠ -2798,8 +2807,10 ＠＠ } static void -mswindows_tree_view_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, +mswindows_tree_view_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { Lisp_Object rest; ＠＠ -2901,8 +2912,10 ＠＠ } static void -mswindows_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, +mswindows_tab_control_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { /* This function can call lisp */ ＠＠ -3016,7 +3029,8 ＠＠ /* instantiate a static control possible for putting other things in */ static void -mswindows_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_label_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { ＠＠ -3027,8 +3041,10 ＠＠ /* instantiate a scrollbar control */ static void -mswindows_scrollbar_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, +mswindows_scrollbar_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, ＠＠ -3038,8 +3054,10 ＠＠ /* instantiate a combo control */ static void -mswindows_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, +mswindows_combo_box_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Index: src/gpmevent.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/gpmevent.c,v retrieving revision 1.5.2.11 diff -u -w -r1.5.2.11 gpmevent.c --- gpmevent.c 2001/01/12 08:32:34 1.5.2.11 +++ gpmevent.c 2001/02/24 00:34:46 ＠＠ -29,7 +29,6 ＠＠ #include "console-tty.h" #include "device.h" #include "events.h" -#include "events-mod.h" #include "sysdep.h" #include "commands.h" #include "lstream.h" Index: src/keymap.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/keymap.c,v retrieving revision 1.27.2.23 diff -u -w -r1.27.2.23 keymap.c --- keymap.c 2001/02/01 08:54:05 1.27.2.23 +++ keymap.c 2001/02/24 00:34:48 ＠＠ -37,7 +37,6 ＠＠ #include "insdel.h" #include "keymap.h" #include "window.h" -#include "events-mod.h"  /* A keymap contains six slots: ＠＠ -3438,6 +3437,24 ＠＠ return where_is_internal (definition, gubbish, nmaps, firstonly, 0); } +static void +format_raw_keys (struct key_data *keys, int count, char *buf) +{ + int i; + Lisp_Event event; + event.event_type = key_press_event; + event.channel = Vselected_console; + for (i = 0; i < count; i++) + { + event.event.key.keysym = keys[i].keysym; + event.event.key.modifiers = keys[i].modifiers; + format_event_object (buf, &event, 1); + buf += strlen (buf); + if (i < count-1) + buf[0] = ' ', buf++; + } +} + /* This function is like (key-description (where-is-internal definition nil t)) except that it writes its output into a (char *) buffer that you ＠＠ -3452,6 +3469,55 ＠＠ Lisp_Object *gubbish = maps; int nmaps; +#if 0 /* #### ignore this code -- ben */ + if (SYMBOLP (definition)) + { + Lisp_Object keys = Fget (definition, Qpreferred_key_sequence, Qnil); + + if (!NILP (keys)) + { + int idx; + int len; + struct gcpro gcpro1, gcpro2, gcpro3; + + if (VECTORP (keys)) + len = XVECTOR_LENGTH (keys); + else if (STRINGP (keys)) + len = XSTRING_CHAR_LENGTH (keys); + else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys)) + { + struct key_data cle_crue; + + define_key_parser (keys, &cle_crue); + format_raw_keys (&cle_crue, 1, buffer); + return; + } + else + { + keys = wrong_type_argument (Qsequencep, keys); + len = XINT (Flength (keys)); + } + + for (idx = 0; idx < len; idx++) + { + Lisp_Object c; + struct key_data raw_key; + + if (STRINGP (keys)) + c = make_char (string_char (XSTRING (keys), idx)); + else + c = XVECTOR_DATA (keys) [idx]; + + define_key_parser (c, &raw_key); + format_raw_keys (&raw_key, 1, buffer); + buffer += strlen (buffer); + } + + return; + } + } +#endif + /* Get keymaps as an array */ nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish); if (nmaps > countof (maps)) ＠＠ -3475,25 +3541,6 ＠＠ } -static void -format_raw_keys (struct key_data *keys, int count, char *buf) -{ - int i; - Lisp_Event event; - event.event_type = key_press_event; - event.channel = Vselected_console; - for (i = 0; i < count; i++) - { - event.event.key.keysym = keys[i].keysym; - event.event.key.modifiers = keys[i].modifiers; - format_event_object (buf, &event, 1); - buf += strlen (buf); - if (i < count-1) - buf[0] = ' ', buf++; - } -} - - /* definition is the thing to look for. map is a keymap. shadow is an array of shadow_count keymaps; if there is a different ＠＠ -4223,14 +4270,14 ＠＠ { INIT_LRECORD_IMPLEMENTATION (keymap); - defsymbol (&Qminor_mode_map_alist, "minor-mode-map-alist"); + DEFSYMBOL (Qminor_mode_map_alist); - defsymbol (&Qkeymapp, "keymapp"); + DEFSYMBOL (Qkeymapp); - defsymbol (&Qsuppress_keymap, "suppress-keymap"); + DEFSYMBOL (Qsuppress_keymap); - defsymbol (&Qmodeline_map, "modeline-map"); - defsymbol (&Qtoolbar_map, "toolbar-map"); + DEFSYMBOL (Qmodeline_map); + DEFSYMBOL (Qtoolbar_map); DEFSUBR (Fkeymap_parents); DEFSUBR (Fset_keymap_parents); ＠＠ -4265,51 +4312,51 ＠＠ DEFSUBR (Ftext_char_description); - defsymbol (&Qcontrol, "control"); - defsymbol (&Qctrl, "ctrl"); - defsymbol (&Qmeta, "meta"); - defsymbol (&Qsuper, "super"); - defsymbol (&Qhyper, "hyper"); - defsymbol (&Qalt, "alt"); - defsymbol (&Qshift, "shift"); - defsymbol (&Qbutton0, "button0"); - defsymbol (&Qbutton1, "button1"); - defsymbol (&Qbutton2, "button2"); - defsymbol (&Qbutton3, "button3"); - defsymbol (&Qbutton4, "button4"); - defsymbol (&Qbutton5, "button5"); - defsymbol (&Qbutton6, "button6"); - defsymbol (&Qbutton7, "button7"); - defsymbol (&Qbutton0up, "button0up"); - defsymbol (&Qbutton1up, "button1up"); - defsymbol (&Qbutton2up, "button2up"); - defsymbol (&Qbutton3up, "button3up"); - defsymbol (&Qbutton4up, "button4up"); - defsymbol (&Qbutton5up, "button5up"); - defsymbol (&Qbutton6up, "button6up"); - defsymbol (&Qbutton7up, "button7up"); - defsymbol (&Qmouse_1, "mouse-1"); - defsymbol (&Qmouse_2, "mouse-2"); - defsymbol (&Qmouse_3, "mouse-3"); - defsymbol (&Qmouse_4, "mouse-4"); - defsymbol (&Qmouse_5, "mouse-5"); - defsymbol (&Qmouse_6, "mouse-6"); - defsymbol (&Qmouse_7, "mouse-7"); - defsymbol (&Qdown_mouse_1, "down-mouse-1"); - defsymbol (&Qdown_mouse_2, "down-mouse-2"); - defsymbol (&Qdown_mouse_3, "down-mouse-3"); - defsymbol (&Qdown_mouse_4, "down-mouse-4"); - defsymbol (&Qdown_mouse_5, "down-mouse-5"); - defsymbol (&Qdown_mouse_6, "down-mouse-6"); - defsymbol (&Qdown_mouse_7, "down-mouse-7"); - defsymbol (&Qmenu_selection, "menu-selection"); - defsymbol (&QLFD, "LFD"); - defsymbol (&QTAB, "TAB"); - defsymbol (&QRET, "RET"); - defsymbol (&QESC, "ESC"); - defsymbol (&QDEL, "DEL"); - defsymbol (&QSPC, "SPC"); - defsymbol (&QBS, "BS"); + DEFSYMBOL (Qcontrol); + DEFSYMBOL (Qctrl); + DEFSYMBOL (Qmeta); + DEFSYMBOL (Qsuper); + DEFSYMBOL (Qhyper); + DEFSYMBOL (Qalt); + DEFSYMBOL (Qshift); + DEFSYMBOL (Qbutton0); + DEFSYMBOL (Qbutton1); + DEFSYMBOL (Qbutton2); + DEFSYMBOL (Qbutton3); + DEFSYMBOL (Qbutton4); + DEFSYMBOL (Qbutton5); + DEFSYMBOL (Qbutton6); + DEFSYMBOL (Qbutton7); + DEFSYMBOL (Qbutton0up); + DEFSYMBOL (Qbutton1up); + DEFSYMBOL (Qbutton2up); + DEFSYMBOL (Qbutton3up); + DEFSYMBOL (Qbutton4up); + DEFSYMBOL (Qbutton5up); + DEFSYMBOL (Qbutton6up); + DEFSYMBOL (Qbutton7up); + DEFSYMBOL (Qmouse_1); + DEFSYMBOL (Qmouse_2); + DEFSYMBOL (Qmouse_3); + DEFSYMBOL (Qmouse_4); + DEFSYMBOL (Qmouse_5); + DEFSYMBOL (Qmouse_6); + DEFSYMBOL (Qmouse_7); + DEFSYMBOL (Qdown_mouse_1); + DEFSYMBOL (Qdown_mouse_2); + DEFSYMBOL (Qdown_mouse_3); + DEFSYMBOL (Qdown_mouse_4); + DEFSYMBOL (Qdown_mouse_5); + DEFSYMBOL (Qdown_mouse_6); + DEFSYMBOL (Qdown_mouse_7); + DEFSYMBOL (Qmenu_selection); + DEFSYMBOL (QLFD); + DEFSYMBOL (QTAB); + DEFSYMBOL (QRET); + DEFSYMBOL (QESC); + DEFSYMBOL (QDEL); + DEFSYMBOL (QSPC); + DEFSYMBOL (QBS); } void Index: src/nt.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/nt.c,v retrieving revision 1.17.2.25 diff -u -w -r1.17.2.25 nt.c --- nt.c 2001/01/28 06:56:07 1.17.2.25 +++ nt.c 2001/02/24 00:34:49 ＠＠ -1421,7 +1421,7 ＠＠ } else { - buf->st_nlink = info.nNumberOfLinks; + buf->st_nlink = (short) info.nNumberOfLinks; /* Might as well use file index to fake inode values, but this is not guaranteed to be unique unless we keep a handle open all the time (even then there are situations where it is ＠＠ -1432,9 +1432,9 ＠＠ /* MSVC defines _ino_t to be short; other libc's might not. */ if (sizeof (buf->st_ino) == 2) - buf->st_ino = fake_inode ^ (fake_inode >> 16); + buf->st_ino = (unsigned short) (fake_inode ^ (fake_inode >> 16)); else - buf->st_ino = fake_inode; + buf->st_ino = (unsigned short) fake_inode; /* consider files to belong to current user */ buf->st_uid = 0; ＠＠ -1618,7 +1618,7 ＠＠ buf->st_ino = (unsigned short) (fake_inode ^ (fake_inode >> 16)); /* consider files to belong to current user */ - buf->st_uid = buf->st_gid = nt_fake_unix_uid; + buf->st_uid = buf->st_gid = (short) nt_fake_unix_uid; /* volume_info is set indirectly by map_win32_filename */ buf->st_dev = volume_info.serialnum; Index: src/search.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/search.c,v retrieving revision 1.14.2.18 diff -u -w -r1.14.2.18 search.c --- search.c 2001/02/09 16:00:36 1.14.2.18 +++ search.c 2001/02/24 00:34:49 ＠＠ -1563,7 +1563,7 ＠＠ in the pattern. Others don't matter anyway! */ xzero (simple_translate); for (i = 0; i < 0400; i++) - simple_translate[i] = i; + simple_translate[i] = (Bufbyte) i; i = 0; while (i != infinity) { ＠＠ -1648,7 +1648,7 ＠＠ while ((j = TRANSLATE (inverse_trt, j)) != k) { - simple_translate[j] = k; + simple_translate[j] = (Bufbyte) k; BM_tab[j] = dirlen - i; } #endif Index: src/sysdep.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/sysdep.c,v retrieving revision 1.32.2.45 diff -u -w -r1.32.2.45 sysdep.c --- sysdep.c 2001/02/09 06:08:21 1.32.2.45 +++ sysdep.c 2001/02/24 00:34:51 ＠＠ -2985,23 +2985,22 ＠＠ if (rtnval == NULL) /* End of directory */ return NULL; { - Extcount external_len; - int ascii_filename_p = 1; const Extbyte * const external_name = (const Extbyte *) rtnval->d_name; + Extcount external_len = strlen (rtnval->d_name); + const Bufbyte *internal_name; + Bytecount internal_len; + + TO_INTERNAL_FORMAT (DATA, (external_name, external_len), + ALLOCA, (internal_name, internal_len), + Qfile_name); - /* Optimize for the common all-ASCII case, computing len en passant */ - for (external_len = 0; external_name[external_len] ; external_len++) - { - if (!BYTE_ASCII_P (external_name[external_len])) - ascii_filename_p = 0; - } - if (ascii_filename_p) + /* check for common case of ASCII filename */ + if (internal_len == external_len && + !memcmp (external_name, internal_name, internal_len)) return rtnval; { /* Non-ASCII filename */ static Bufbyte_dynarr *internal_DIRENTRY; - const Bufbyte *internal_name; - Bytecount internal_len; if (!internal_DIRENTRY) internal_DIRENTRY = Dynarr_new (Bufbyte); else ＠＠ -3010,9 +3009,6 ＠＠ Dynarr_add_many (internal_DIRENTRY, (Bufbyte *) rtnval, offsetof (DIRENTRY, d_name)); - TO_INTERNAL_FORMAT (DATA, (external_name, external_len), - ALLOCA, (internal_name, internal_len), - Qfile_name); Dynarr_add_many (internal_DIRENTRY, internal_name, internal_len); Dynarr_add (internal_DIRENTRY, '\0'); /* NUL-terminate */ Index: src/emacs.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/emacs.c,v retrieving revision 1.82.2.85 diff -u -w -r1.82.2.85 emacs.c --- emacs.c 2001/02/12 12:58:26 1.82.2.85 +++ emacs.c 2001/02/24 00:34:52 ＠＠ -461,8 +461,8 ＠＠ static JMP_BUF run_temacs_catch; static int run_temacs_argc; -static char **run_temacs_argv; -static char *run_temacs_args; +static Extbyte **run_temacs_argv; +static Extbyte *run_temacs_args; static size_t run_temacs_argv_size; static size_t run_temacs_args_size; ＠＠ -657,7 +657,7 ＠＠ if (i == 0) { /* Do not trust to what crt0 has stuffed into argv[0] */ - char full_exe_path[MAX_PATH]; + Extbyte full_exe_path[MAX_PATH]; Lisp_Object fullpath; GetModuleFileName (NULL, full_exe_path, MAX_PATH); ＠＠ -994,6 +994,8 ＠＠ noninteractive = 1; } + /* #### is it correct that -debug-paths is handled here (and presumably + removed), and then checked again below? */ if (argmatch (argv, argc, "-debug-paths", "--debug-paths", 11, NULL, &skip_args)) debug_paths = 1; Index: nt/config.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/nt/config.h,v retrieving revision 1.19.2.19 diff -u -w -r1.19.2.19 config.h --- config.h 2001/02/09 06:08:22 1.19.2.19 +++ config.h 2001/02/24 00:34:52 ＠＠ -610,6 +610,10 ＠＠ /* 'expression' : signed/unsigned mismatch */ #pragma warning ( disable : 4018 ) +/* unnamed type definition in parentheses + (Martin added a pedantically correct definition of ALIGNOF, which + generates temporary anonymous structures, and MSVC complains) */ +#pragma warning ( disable : 4116 ) #endif /* compiler understands #pragma warning*/ Index: lisp/auto-save.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/auto-save.el,v retrieving revision 1.3.2.3 diff -u -w -r1.3.2.3 auto-save.el --- auto-save.el 2000/01/26 11:36:32 1.3.2.3 +++ auto-save.el 2001/02/24 00:34:57 ＠＠ -2,6 +2,7 ＠＠ ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Copyright (C) 1992 by Sebastian Kremer <sk(a)thp.uni-koeln.de&gt; +;; Copyright (C) 2001 Ben Wing. ;; Author: Sebastian Kremer <sk(a)thp.uni-koeln.de&gt; ;; Maintainer: XEmacs Development Team ＠＠ -34,13 +35,10 ＠＠ ;; disk, in case NFS is slow. The auto-save file used for ;; /usr/foo/bar/baz.txt ;; will be -;; AUTOSAVE/#\!usr\!foo\!bar\!baz.txt# +;; AUTOSAVE/#=2Fusr=2Ffoo=2Fbar=2Fbaz.txt#" ;; assuming AUTOSAVE is the non-nil value of the variable ;; `auto-save-directory'. -;; Takes care that autosave files for non-file-buffers (e.g. *mail*) -;; from two simultaneous Emacses don't collide. - ;; Autosaves even if the current directory is not writable. ;; Can limit autosave names to 14 characters using a hash function, ＠＠ -60,7 +58,7 ＠＠ ;; (concat "/tmp/" (user-login-name) "-autosave/")) ;; If you don't want to save in /tmp (e.g., because it is swap -;; mounted) but rather in ~/autosave/ +;; mounted) but rather in ~/.autosave/ ;; (setq auto-save-directory (expand-file-name "~/.autosave/")) ;; If you want to save each file in its own directory (the default) ＠＠ -144,7 +142,7 ＠＠ will have a longish filename like - AUTO-SAVE-DIRECTORY/#\\!home\\!sk\\!lib\\!emacs\\!lisp\\!auto-save.el# + AUTO-SAVE-DIRECTORY/#=2Fhome=2Fsk=2Flib=2Femacs=2Flisp=2Fauto-save.el# as auto save file. ＠＠ -221,13 +219,8 ＠＠  ;;; Computing an autosave name for a file and vice versa - -;; #### Now that this file is dumped, we should turn off the routine -;; from files.el. But it would make it harder to remove it! -(defun make-auto-save-file-name (&optional file-name);; redefines files.el - ;; auto-save-file-name-p need not be redefined. - +(defun make-auto-save-file-name (&optional file-name) "Return file name to use for auto-saves of current buffer. Does not consider `auto-save-visited-file-name'; that is checked before calling this function. ＠＠ -285,8 +278,8 ＠＠ (save-name (or file-name ;; Prevent autosave errors. Buffername ;; (to become non-dir part of filename) will - ;; be unslashified twice. Don't care. - (auto-save-unslashify-name (buffer-name)))) + ;; be escaped twice. Don't care. + (auto-save-escape-name (buffer-name)))) (remote-p (and (stringp file-name) (fboundp 'efs-ftp-path) (efs-ftp-path file-name)))) ＠＠ -316,12 +309,26 ＠＠ (error (warn "Error caught in `make-auto-save-file-name':\n%s" (error-message-string error-data)) - (if buffer-file-name - (concat (file-name-directory buffer-file-name) + (let ((fname + (if file-name + (concat (file-name-directory file-name) "#" - (file-name-nondirectory buffer-file-name) + (file-name-nondirectory file-name) "#") - (expand-file-name (concat "#%" (buffer-name) "#")))))) + (expand-file-name + (concat "#%" (auto-save-escape-name (buffer-name)) + "#"))))) + (if (or (file-writable-p fname) + (file-exists-p fname)) + fname + (expand-file-name (concat "~/" + (file-name-nondirectory fname)))))))) + +(defun auto-save-file-name-p (filename) + "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. +FILENAME should lack slashes. +You can redefine this for customization." + (string-match "\\`#.*#\\'" filename)) (defun auto-save-original-name (savename) "Reverse of `make-auto-save-file-name'. ＠＠ -342,13 +349,13 ＠＠ (equal savedir (expand-file-name auto-save-directory-fallback))) ;; it is of the `-fixed-directory' type - (auto-save-slashify-name (substring basename 1 -1))) + (auto-save-unescape-name (substring basename 1 -1))) (t ;; else it is of `-same-directory' type (concat savedir (substring basename 1 -1)))))) (defun auto-save-name-in-fixed-directory (filename &optional prefix) - ;; Unslashify and enclose the whole FILENAME in `#' to make an auto + ;; Escape and enclose the whole FILENAME in `#' to make an auto ;; save file in the auto-save-directory, or if that is nil, in ;; auto-save-directory-fallback (which must be the name of an ;; existing directory). If the results would be too long for 14 ＠＠ -356,7 +363,7 ＠＠ ;; into a shorter name. ;; Optional PREFIX is string to use instead of "#" to prefix name. (let ((base-name (concat (or prefix "#") - (auto-save-unslashify-name filename) + (auto-save-escape-name filename) "#"))) (if (and auto-save-hash-p auto-save-hash-directory ＠＠ -385,35 +392,84 ＠＠ (or prefix "#") (file-name-nondirectory filename) "#"))) - -;; #### The following two should probably use `replace-in-string'. -(defun auto-save-unslashify-name (s) - ;; "Quote any slashes in string S by replacing them with the two - ;;characters `\\!'. - ;;Also, replace any backslash by double backslash, to make it one-to-one." - (let ((limit 0)) - (while (string-match "[/\\]" s limit) - (setq s (concat (substring s 0 (match-beginning 0)) - (if (string= (substring s - (match-beginning 0) - (match-end 0)) - "/") - "\\!" - "\\\\") - (substring s (match-end 0)))) - (setq limit (1+ (match-end 0))))) - s) +(defconst auto-save-reserved-chars + '( + ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\10 ?\11 ?\12 ?\13 ?\14 ?\15 ?\16 + ?\17 ?\20 ?\21 ?\22 ?\23 ?\24 ?\25 ?\26 ?\27 ?\30 ?\31 ?\32 ?\33 + ?\34 ?\35 ?\36 ?\37 ?\40 ?? ?* ?: ?< ?> ?| ?/ ?\\ ?& ?^ ?% ?= ?\") + "List of characters disallowed (or potentially disallowed) in filenames. +Includes everything that can get us into trouble under MS Windows or Unix.") + +;; This code based on code in Bill Perry's url.el. + +(defun auto-save-escape-name (str) + "Escape any evil nasty characters in a potential filename. +Uses quoted-printable-style escaping -- e.g. the dreaded =3D. +Does not use URL escaping (with %) because filenames beginning with #% are +a special signal for non-file buffers." + (mapconcat + (function + (lambda (char) + (if (memq char auto-save-reserved-chars) + (if (< char 16) + (upcase (format "=0%x" char)) + (upcase (format "=%x" char))) + (char-to-string char)))) + str "")) + +(defun auto-save-unhex (x) + (if (> x ?9) + (if (>= x ?a) + (+ 10 (- x ?a)) + (+ 10 (- x ?A))) + (- x ?0))) + +(defun auto-save-unescape-name (str) + "Undo any escaping of evil nasty characters in a file name. +See `auto-save-escape-name'." + (setq str (or str "")) + (let ((tmp "") + (case-fold-search t)) + (while (string-match "=[0-9a-f][0-9a-f]" str) + (let* ((start (match-beginning 0)) + (ch1 (auto-save-unhex (elt str (+ start 1)))) + (code (+ (* 16 ch1) + (auto-save-unhex (elt str (+ start 2)))))) + (setq tmp (concat tmp (substring str 0 start) + (char-to-string code)) + str (substring str (match-end 0))))) + (setq tmp (concat tmp str)) + tmp)) + +;; The old versions are below. + +;(defun auto-save-escape-name (s) +; ;; "Quote any slashes in string S by replacing them with the two +; ;;characters `\\!'. +; ;;Also, replace any backslash by double backslash, to make it one-to-one." +; (let ((limit 0)) +; (while (string-match "[/\\]" s limit) +; (setq s (concat (substring s 0 (match-beginning 0)) +; (if (string= (substring s +; (match-beginning 0) +; (match-end 0)) +; "/") +; "\\!" +; "\\\\") +; (substring s (match-end 0)))) +; (setq limit (1+ (match-end 0))))) +; s) -(defun auto-save-slashify-name (s) - ;;"Reverse of `auto-save-unslashify-name'." - (let (pos) - (while (setq pos (string-match "\\\\[\\!]" s pos)) - (setq s (concat (substring s 0 pos) - (if (eq ?! (aref s (1+ pos))) "/" "\\") - (substring s (+ pos 2))) - pos (1+ pos)))) - s) +;(defun auto-save-unescape-name (s) +; ;;"Reverse of `auto-save-escape-name'." +; (let (pos) +; (while (setq pos (string-match "\\\\[\\!]" s pos)) +; (setq s (concat (substring s 0 pos) +; (if (eq ?! (aref s (1+ pos))) "/" "\\") +; (substring s (+ pos 2))) +; pos (1+ pos)))) +; s)  ;;; Hashing for autosave names ＠＠ -454,7 +510,7 ＠＠ ;; This leaves two characters that could be used to wrap it in `#' or ;; make two filenames from it: one for autosaving, and another for a -;; file containing the name of the autosaved filed, to make hashing +;; file containing the name of the autosaved file, to make hashing ;; reversible. ;(defun auto-save-cyclic-hash-12 (s) ; "Outputs the 12-characters ascii hex representation of a 6-bytes ＠＠ -518,8 +574,14 ＠＠ (t (incf total) (with-output-to-temp-buffer "*Directory*" - (apply 'call-process "ls" nil standard-output nil - "-l" afile (if file (list file)))) + (buffer-disable-undo standard-output) + (save-excursion + (set-buffer "*Directory*") + (setq default-directory (file-name-directory afile)) + (insert-directory afile "-l") + (when file + (setq default-directory (file-name-directory file)) + (insert-directory file "-l")))) (if (yes-or-no-p (format "Recover %s from auto save file? " (or file "non-file buffer"))) (let* ((obuf (current-buffer))) Index: lisp/bytecomp-runtime.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/bytecomp-runtime.el,v retrieving revision 1.5.2.2 diff -u -w -r1.5.2.2 bytecomp-runtime.el --- bytecomp-runtime.el 1999/11/27 05:27:23 1.5.2.2 +++ bytecomp-runtime.el 2001/02/24 00:34:57 ＠＠ -186,6 +186,252 ＠＠  +;;; Functions to cleanly eliminate warnings about undefined functions +;;; or variables when the code knows what it's doing. These macros DO +;;; NOT rely on any byte-compiler changes, and thus can be copied into +;;; a package and used within it. + +;; NOTE: As a result of the above requirement, the macros rely on +;; "tricks" to get the warnings suppressed. A cleaner way, of course, +;; would be to extend the byte compiler to provide a proper interface. + +;; #### Should we require an unquoted symbol rather than a quoted one, +;; as we currently do? The quoting gets no generality, as `eval' is +;; called at compile time. But most functions and macros want quoted +;; arguments, and I find it extremely confusing to deal with cases +;; such as `throw' requiring a quoted argument but `block' an unquoted +;; one. + +(put 'with-boundp 'lisp-indent-function 1) +(defmacro with-boundp (symbols &rest body) + "Evaluate BODY, but do not issue bytecomp warnings about SYMBOLS undefined. +SYMBOLS can be a symbol or a list of symbols and must be quoted. When +compiling this file, the warning `reference to free variable SYMBOL' +will not occur. This is a clean way to avoid such warnings. See also +`declare-boundp' and `if-boundp'." + (setq symbols (eval symbols)) + (unless (consp symbols) + (setq symbols (list symbols))) + `(progn + (declare (special ,symbols)) + ,＠body)) + +(put 'if-boundp 'lisp-indent-function 2) +(defmacro if-boundp (symbol then &rest else) + "Equivalent to (if (boundp SYMBOL) THEN ELSE) but handles bytecomp warnings. +When compiling this file, the warning `reference to free variable SYMBOL' +will not occur. This is a clean way to avoid such warnings. See also +`with-boundp' and `declare-boundp'." + `(with-boundp ,symbol + (if (boundp ,symbol) ,then ,＠else))) + +(defmacro declare-boundp (symbol) + "Evaluate SYMBOL without bytecomp warnings about the symbol. +Sample usage is + + (declare-boundp gpm-minor-mode) + +which is equivalent to + + (with-fboundp 'gpm-minor-mode + gpm-minor-mode)" + `(with-boundp ',symbol ,symbol)) + +(defmacro globally-declare-boundp (symbol) + "Declare that all free uses of SYMBOL in this file are valid. +SYMBOL can also be a list of symbols. SYMBOL must be quoted. + +When compiling this file, the warning `reference to free variable +SYMBOL' will not occur regardless of where calls to SYMBOL occur in +the file. + +In general, you should *NOT* use this; use `declare-boundp', +`if-boundp', or `with-boundp' to wrap individual uses, as necessary. +That way, you're more likely to remember to put in the explicit checks +for the variable's existence that are usually necessary. However, +`globally-declare-boundp' is better in some circumstances, such as +when writing an ELisp package that makes integral use of +optionally-compiled-in functionality (typically, an interface onto a +system library) and checks for the existence of the functionality at +some entry point to the package. See `globally-declare-fboundp' for +more information." + (setq symbol (eval symbol)) + (if (not (consp symbol)) + (setq symbol (list symbol))) + `(progn + ;; (defvar FOO) has no side effects. + ,＠(mapcar #'(lambda (sym) `(defvar ,sym)) symbol))) + +(defun byte-compile-with-fboundp (form) + (byte-compile-form (cons 'progn (cdr (cdr form)))) + ;; Unfortunately, byte-compile-unresolved-functions is used not only + ;; for unresolved-function warnings, but also in connection with the + ;; following warnings: + + ;; "defsubst %s was used before it was defined" + ;; "%s being defined to take %s%s, but was previously called with %s" + + ;; By hacking byte-compile-unresolved-functions like this, we + ;; effectively disable these warnings. But code should not be using + ;; `with-fboundp' with a function defined later on in the same + ;; file, so this is not a big deal. + + (let ((symbols (eval (car (cdr form))))) + (unless (consp symbols) + (setq symbols (list symbols))) + (setq symbols (mapcar #'(lambda (sym) (cons sym nil)) symbols)) + (setq byte-compile-unresolved-functions + (set-difference byte-compile-unresolved-functions symbols + :key #'car)) + )) + +;; EEEEEEEEVIL hack. We need to create our own byte-compilation +;; method so that the proper variables are bound while compilation +;; takes place (which is when the warnings get noticed and batched +;; up). What we really want to do is make `with-fboundp' a macro +;; that simply `progn's its BODY; but GOD DAMN IT, macros can't have +;; their own byte-compilation methods! So we make `with-fboundp' a +;; macro calling `with-fboundp-1', which is cleverly aliased to +;; progn. This way we can put a byte-compilation method on +;; `with-fboundp-1', and when interpreting, progn will duly skip +;; the first, quoted argument, i.e. the symbol name. (We could make +;; `with-fboundp-1' a regular function, but then we'd have to thunk +;; BODY and eval it at runtime. We could probably just do this using +;; (apply 'progn BODY), but the existing method is more obviously +;; guaranteed to work.) +;; +;; In defense, cl-macs.el does a very similar thing with +;; `cl-block-wrapper'. + +(put 'with-fboundp-1 'byte-compile 'byte-compile-with-fboundp) +(defalias 'with-fboundp-1 'progn) + +(put 'with-fboundp 'lisp-indent-function 1) +(defmacro with-fboundp (symbol &rest body) + "Evaluate BODY, but do not issue bytecomp warnings about SYMBOL. +SYMBOL must be quoted. When compiling this file, the warning `the +function SYMBOL is not known to be defined' will not occur. This is a +clean way to avoid such warnings. See also `declare-fboundp', +`if-fboundp', and `globally-declare-fboundp'." + `(with-fboundp-1 ,symbol ,＠body)) + +(put 'if-fboundp 'lisp-indent-function 2) +(defmacro if-fboundp (symbol then &rest else) + "Equivalent to (if (fboundp SYMBOL) THEN ELSE) but handles bytecomp warnings. +When compiling this file, the warning `the function SYMBOL is not +known to be defined' will not occur. This is a clean way to avoid +such warnings. See also `declare-fboundp', `with-fboundp', and +`globally-declare-fboundp'." + `(with-fboundp ,symbol + (if (fboundp ,symbol) ,then ,＠else))) + +(defmacro declare-fboundp (form) + "Execute FORM (a function call) without bytecomp warnings about the call. +Sample usage is + + (declare-fboundp (x-keysym-on-keyboard-sans-modifiers-p 'backspace)) + +which is equivalent to + + (with-fboundp 'x-keysym-on-keyboard-sans-modifiers-p + (x-keysym-on-keyboard-sans-modifiers-p 'backspace))" + `(with-fboundp ',(car form) ,form)) + +(defmacro globally-declare-fboundp (symbol) + "Declare that all calls to function SYMBOL in this file are valid. +SYMBOL can also be a list of symbols. SYMBOL must be quoted. + +When compiling this file, the warning `the function SYMBOL is not +known to be defined' will not occur regardless of where calls to +SYMBOL occur in the file. + +In general, you should *NOT* use this; use `declare-fboundp', +`if-fboundp', or `with-fboundp' to wrap individual uses, as necessary. +That way, you're more likely to remember to put in the explicit checks +for the function's existence that are usually necessary. However, +`globally-declare-fboundp' is better in some circumstances, such as +when writing an ELisp package that makes integral use of +optionally-compiled-in functionality (typically, an interface onto a +system library) and checks for the existence of the functionality at +some entry point to the package. The file `ldap.el' is a good +example: It provides a layer on top of the optional LDAP ELisp +primitives, makes calls to them throughout its code, and verifies the +presence of LDAP support at load time. Putting calls to +`declare-fboundp' throughout the code would be a major annoyance." + (when (cl-compiling-file) + (setq symbol (eval symbol)) + (if (not (consp symbol)) + (setq symbol (list symbol))) + ;; Another hack. This works because the autoload environment is + ;; currently used ONLY to suppress warnings, and the actual + ;; autoload definition is not used. (NOTE: With this definition, + ;; we will get spurious "multiple autoloads for %s" warnings if we + ;; have an autoload later in the file for any functions in SYMBOL. + ;; This is not something that code should ever do, though.) + (setq byte-compile-autoload-environment + (append (mapcar #'(lambda (sym) (cons sym nil)) symbol) + byte-compile-autoload-environment))) + nil) + +(defun byte-compile-with-byte-compiler-warnings-suppressed (form) + (let ((byte-compile-warnings byte-compile-warnings) + (types (car (cdr form)))) + (unless (consp types) + (setq types (list types))) + (if (eq byte-compile-warnings t) + (setq byte-compile-warnings byte-compile-default-warnings)) + (setq byte-compile-warnings (set-difference byte-compile-warnings types)) + (byte-compile-form (cons 'progn (cdr (cdr form)))))) + +;; Same hack here as with `with-fboundp'. +(put 'with-byte-compiler-warnings-suppressed-1 'byte-compile + 'byte-compile-with-byte-compiler-warnings-suppressed) +(defalias 'with-byte-compiler-warnings-suppressed-1 'progn) + +(put 'with-byte-compiler-warnings-suppressed 'lisp-indent-function 1) +(defmacro with-byte-compiler-warnings-suppressed (type &rest body) + "Evaluate BODY, but do not issue bytecomp warnings TYPE. +TYPE should be one of `redefine', `callargs', `subr-callargs', +`free-vars', `unresolved', `unused-vars', `obsolete', or `pedantic', +or a list of one or more of these symbols. (See `byte-compile-warnings'.) +TYPE must be quoted. + +NOTE: You should *NOT* under normal circumstances be using this! +There are better ways of avoiding most of these warnings. In particular: + +-- use (declare (special ...)) if you are making use of + dynamically-scoped variables. +-- use `with-fboundp', `declare-fboundp', `if-fboundp', or + `globally-declare-fboundp' to avoid warnings about undefined + functions when you know the function actually exists. +-- use `with-boundp', `declare-boundp', or `if-boundp' to avoid + warnings about undefined variables when you know the variable + actually exists. +-- use `with-obsolete-variable' or `with-obsolete-function' if you + are purposely using such a variable or function." + `(with-byte-compiler-warnings-suppressed-1 ,type ,＠body)) + +;; #### These should be more clever. You could (e.g.) try fletting +;; `byte-compile-obsolete' or temporarily removing the obsolete info +;; from the symbol and putting it back with an unwind-protect. (Or +;; better, modify the byte-compiler to provide a proper solution, and +;; fix these macros to use it if available, or fall back on the way +;; below. Remember, these definitions need to work with an unchanged +;; byte compiler so that they can be copied and used in packages.) + +(put 'with-obsolete-variable 'lisp-indent-function 1) +(defmacro with-obsolete-variable (symbol &rest body) + "Evaluate BODY but do not warn about usage of obsolete variable SYMBOL. +SYMBOL must be quoted. See also `with-obsolete-function'." + `(with-byte-compiler-warnings-suppressed 'obsolete ,＠body)) + +(put 'with-obsolete-function 'lisp-indent-function 1) +(defmacro with-obsolete-function (symbol &rest body) + "Evaluate BODY but do not warn about usage of obsolete function SYMBOL. +SYMBOL must be quoted. See also `with-obsolete-variable'." + `(with-byte-compiler-warnings-suppressed 'obsolete ,＠body)) + + ;;; Interface to file-local byte-compiler parameters. ;;; Redefined in bytecomp.el. ＠＠ -222,8 +468,11 ＠＠ unused-vars references to non-global variables bound but not referenced. unresolved calls to unknown functions. callargs lambda calls with args that don't match the definition. + subr-callargs calls to subrs with args that don't match the definition. redefine function cell redefined from a macro to a lambda or vice versa, or redefined to take a different number of arguments. + obsolete use of an obsolete function or variable. + pedantic warn of use of compatible symbols. If the first element if the list is `+' or `-' then the specified elements are added to or removed from the current set of warnings, instead of the Index: lisp/console.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/console.el,v retrieving revision 1.2 diff -u -w -r1.2 console.el --- console.el 1997/11/09 07:06:29 1.2 +++ console.el 2001/02/24 00:34:57 ＠＠ -41,7 +41,8 ＠＠ "Resume the consoles with a controlling process of PID." (mapc (lambda (c) (if (and (eq (console-type c) 'tty) - (eql pid (console-tty-controlling-process c))) + (eql pid + (declare-fboundp (console-tty-controlling-process c)))) (resume-console c))) (console-list)) nil) Index: lisp/help-macro.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/help-macro.el,v retrieving revision 1.3 diff -u -w -r1.3 help-macro.el --- help-macro.el 1998/01/25 09:54:45 1.3 +++ help-macro.el 2001/02/24 00:34:57 ＠＠ -78,13 +78,15 ＠＠ (defmacro make-help-screen (fname help-line help-text helped-map) "Construct help-menu function name FNAME. -When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP. -If the command is the help character, FNAME displays HELP-TEXT -and continues trying to read a command using HELPED-MAP. -When FNAME finally does get a command, it executes that command -and then returns." +When invoked, FNAME shows HELP-LINE and reads a command using +HELPED-MAP. If the command is the help character, FNAME displays +HELP-TEXT and continues trying to read a command using HELPED-MAP. +When FNAME finally does get a command, it executes that command and +then returns. As of 21.5 (or 21.4?), HELP-LINE and HELP-TEXT are +`eval'd, just like for a function call. This allows you to place +Lisp expressions in those arguments." `(defun ,fname () - ,help-text + ,(eval help-text) (interactive) (flet ((help-read-key (prompt) ;; This is in `flet' to avoid problems with autoloading. ＠＠ -105,7 +107,7 ＠＠ (car key) key))))) (let ((line-prompt - (substitute-command-keys ,help-line))) + (substitute-command-keys ,(eval help-line)))) (when three-step-help (message "%s" line-prompt)) (let* ((help-screen (documentation (quote ,fname))) Index: lisp/tty-init.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/tty-init.el,v retrieving revision 1.4 diff -u -w -r1.4 tty-init.el --- tty-init.el 1998/06/30 06:35:26 1.4 +++ tty-init.el 2001/02/24 00:34:57 ＠＠ -36,6 +36,7 ＠＠ ;; called both from init-tty-win and from the C code. (defun init-pre-tty-win () "Initialize TTY at startup (pre). Don't call this." + (with-fboundp 'register-tty-color (unless pre-tty-win-initted (register-tty-color "black" "\e[30m" "\e[40m") (register-tty-color "red" "\e[31m" "\e[41m") ＠＠ -56,7 +57,7 ＠＠ (register-tty-color "brightcyan" "\e[1;36m" "\e[1;46m") (register-tty-color "brightwhite" "\e[1;37m" "\e[1;47m") - (setq pre-tty-win-initted t))) + (setq pre-tty-win-initted t)))) ;; called both from init-tty-win and from the C code. ;; we have to do this for every created TTY console. ＠＠ -67,7 +68,7 ＠＠ ;; override term-file-prefix. (startup.el does it after ;; loading the init file.) (if (featurep 'mule) - (init-mule-tty-win)) + (declare-fboundp (init-mule-tty-win))) (when init-file-loaded ;; temporarily select the console so that the changes ;; to function-key-map are made for the right console. Index: lisp/wid-browse.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/wid-browse.el,v retrieving revision 1.1 diff -u -w -r1.1 wid-browse.el --- wid-browse.el 1997/11/08 05:34:51 1.1 +++ wid-browse.el 2001/02/24 00:34:57 ＠＠ -226,7 +226,7 ＠＠ "Insert description of WIDGET's KEY VALUE. Nothing is assumed about value." (let ((pp (condition-case signal - (pp-to-string value) + (declare-fboundp (pp-to-string value)) (error (prin1-to-string signal))))) (when (string-match "\n\\'" pp) (setq pp (substring pp 0 (1- (length pp))))) Index: lisp/dragdrop.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/dragdrop.el,v retrieving revision 1.7.2.3 diff -u -w -r1.7.2.3 dragdrop.el --- dragdrop.el 2000/08/06 09:26:47 1.7.2.3 +++ dragdrop.el 2001/02/24 00:34:57 ＠＠ -304,7 +304,7 ＠＠ (erase-buffer) (insert data) (and (featurep 'tm-view) - (mime/viewer-mode buf))) + (declare-fboundp (mime/viewer-mode buf)))) ((and (listp data) (= (length data) 3)) ;; change the internal content-type representation to the ＠＠ -318,7 +318,8 ＠＠ (and (featurep 'tm-view) ;; this list of (car data) should be done before ;; enqueing the event - (mime/viewer-mode buf (car data) (cadr data)))) + (declare-fboundp + (mime/viewer-mode buf (car data) (cadr data))))) (t (display-message 'error "Wrong drop data"))))) (undo-boundary) Index: lisp/win32-native.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/Attic/win32-native.el,v retrieving revision 1.1.2.1 diff -u -w -r1.1.2.1 win32-native.el --- win32-native.el 2000/08/06 09:26:52 1.1.2.1 +++ win32-native.el 2001/02/24 00:34:57 ＠＠ -62,32 +62,6 ＠＠ '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3))) ;;---------------------------------------------------------------------- -;; Autosave hack -;;-------------------- - -;; Avoid creating auto-save file names containing invalid characters -;; (primarily "*", eg. for the *mail* buffer). -;; Avoid "doc lost for function" warning -(defun original-make-auto-save-file-name (&optional junk) - "You do not want to call this." - ) -(fset 'original-make-auto-save-file-name - (symbol-function 'make-auto-save-file-name)) - -(defun make-auto-save-file-name () - "Return file name to use for auto-saves of current buffer. -Does not consider `auto-save-visited-file-name' as that variable is checked -before calling this function. You can redefine this for customization. -See also `auto-save-file-name-p'." - (let ((name (original-make-auto-save-file-name)) - (start 0)) - ;; destructively replace occurrences of * or ? with $ - (while (string-match "[?*]" name start) - (aset name (match-beginning 0) ?$) - (setq start (1+ (match-end 0)))) - name)) - -;;---------------------------------------------------------------------- ;; Quoting process args ;;-------------------- Index: lisp/apropos.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/apropos.el,v retrieving revision 1.4.2.6 diff -u -w -r1.4.2.6 apropos.el --- apropos.el 2000/11/06 05:44:06 1.4.2.6 +++ apropos.el 2001/02/24 00:34:57 ＠＠ -69,21 +69,21 ＠＠ Slows them down more or less. Set this non-nil if you have a fast machine.") ;; XEmacs addition -(defvar apropos-symbol-face (if (boundp 'font-lock-keyword-face) +(defvar apropos-symbol-face (if-boundp 'font-lock-keyword-face font-lock-keyword-face 'bold) "*Face for symbol name in apropos output or `nil'. This looks good, but slows down the commands several times.") ;; XEmacs addition -(defvar apropos-keybinding-face (if (boundp 'font-lock-string-face) +(defvar apropos-keybinding-face (if-boundp 'font-lock-string-face font-lock-string-face 'underline) "*Face for keybinding display in apropos output or `nil'. This looks good, but slows down the commands several times.") ;; XEmacs addition -(defvar apropos-label-face (if (boundp 'font-lock-comment-face) +(defvar apropos-label-face (if-boundp 'font-lock-comment-face font-lock-comment-face 'italic) "*Face for label (Command, Variable ...) in apropos output or `nil'. ＠＠ -93,7 +93,7 ＠＠ text-property list for efficiency.") ;; XEmacs addition -(defvar apropos-property-face (if (boundp 'font-lock-variable-name-face) +(defvar apropos-property-face (if-boundp 'font-lock-variable-name-face font-lock-variable-name-face 'bold-italic) "*Face for property name in apropos output or `nil'. Index: lisp/cl-extra.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/cl-extra.el,v retrieving revision 1.7.2.7 diff -u -w -r1.7.2.7 cl-extra.el --- cl-extra.el 2000/12/01 12:22:14 1.7.2.7 +++ cl-extra.el 2001/02/24 00:34:58 ＠＠ -307,9 +307,11 ＠＠ (defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) (or cl-buffer (setq cl-buffer (current-buffer))) - (if (fboundp 'overlay-lists) + (with-fboundp '(overlay-start overlay-end overlays-at next-overlay-change) + (if-fboundp 'overlay-lists - ;; This is the preferred algorithm, though overlay-lists is undocumented. + ;; This is the preferred algorithm, though overlay-lists is + ;; undocumented. (let (cl-ovl) (save-excursion (set-buffer cl-buffer) ＠＠ -320,7 +322,8 ＠＠ (while (and cl-ovl (or (not (overlay-start (car cl-ovl))) (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) - (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) + (and cl-start (<= (overlay-end (car cl-ovl)) + cl-start)) (not (funcall cl-func (car cl-ovl) cl-arg)))) (setq cl-ovl (cdr cl-ovl))) (if cl-start (set-marker cl-start nil)) ＠＠ -344,7 +347,7 ＠＠ (not (and (funcall cl-func (car cl-ovl) cl-arg) (set-marker cl-mark nil))))) (setq cl-ovl (cdr cl-ovl)))) - (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) + (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))))) ;;; Support for `setf'. (defun cl-set-frame-visible-p (frame val) Index: lisp/code-files.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/code-files.el,v retrieving revision 1.4.2.10 diff -u -w -r1.4.2.10 code-files.el --- code-files.el 2000/11/06 05:44:09 1.4.2.10 +++ code-files.el 2001/02/24 00:34:58 ＠＠ -204,53 +204,6 ＠＠ ;(defun convert-mbox-coding-system (filename visit start end) ;... -(defun find-coding-system-magic-cookie () - "Look for the coding-system magic cookie in the current buffer. -The coding-system magic cookie is the exact string -\";;;###coding system: \" followed by a valid coding system symbol, -somewhere within the first 3000 characters of the file. If found, -the coding system symbol is returned; otherwise nil is returned. -Note that it is extremely unlikely that such a string would occur -coincidentally as the result of encoding some characters in a non-ASCII -charset, and that the spaces make it even less likely since the space -character is not a valid octet in any ISO 2022 encoding of most non-ASCII -charsets." - (save-excursion - (goto-char (point-min)) - (or (and (looking-at - "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-") - (let ((codesys (intern (buffer-substring - (match-beginning 1)(match-end 1))))) - (if (find-coding-system codesys) codesys))) - ;; (save-excursion - ;; (let (start end) - ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t) - ;; (setq start (match-end 0)) - ;; (re-search-forward "\n;+[ \t]*End:") - ;; (setq end (match-beginning 0)) - ;; (save-restriction - ;; (narrow-to-region start end) - ;; (goto-char start) - ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t) - ;; ) - ;; (let ((codesys - ;; (intern (buffer-substring - ;; (match-beginning 1)(match-end 1))))) - ;; (if (find-coding-system codesys) codesys)) - ;; ))) - (let ((case-fold-search nil)) - (if (search-forward - ";;;###coding system: " (+ (point-min) 3000) t) - (let ((start (point)) - (end (progn - (skip-chars-forward "^ \t\n\r") - (point)))) - (if (> end start) - (let ((codesys (intern (buffer-substring start end)))) - (if (find-coding-system codesys) codesys))) - ))) - ))) - (defun load (file &optional noerror nomessage nosuffix) "Execute a file of Lisp code named FILE. First tries FILE with .elc appended, then tries with .el, ＠＠ -270,7 +223,8 ＠＠ (if (or (<= (length filename) 0) (null (setq path (locate-file filename load-path - (and (not nosuffix) '(".elc" ".el" "")))))) + (and (not nosuffix) + '(".elc" ".el" "")))))) (and (null noerror) (signal 'file-error (list "Cannot open load file" filename))) ;; now use the internal load to actually load the file. ＠＠ -280,12 +234,10 ＠＠ (string= ".elc" (downcase (substring path -4))))) (or (and (not elc) coding-system-for-read) ; prefer for source file ;; find magic-cookie - (save-excursion - (set-buffer (get-buffer-create " *load*")) - (erase-buffer) - (let ((coding-system-for-read 'raw-text)) - (insert-file-contents path nil 1 3001)) - (find-coding-system-magic-cookie)) + (let ((codesys (find-coding-system-magic-cookie-in-file path))) + (when codesys + (setq codesys (intern codesys)) + (if (find-coding-system codesys) codesys))) (if elc ;; if reading a byte-compiled file and we didn't find ;; a coding-system magic cookie, then use `binary'. Index: lisp/coding.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/coding.el,v retrieving revision 1.2.2.7 diff -u -w -r1.2.2.7 coding.el --- coding.el 2000/10/12 07:22:38 1.2.2.7 +++ coding.el 2001/02/24 00:34:58 ＠＠ -105,8 +105,8 ＠＠ (get-coding-system coding-system) ; correctness check (setq keyboard-coding-system coding-system) (if (eq (device-type) 'tty) - (set-console-tty-input-coding-system - (device-console) keyboard-coding-system)) + (declare-fboundp (set-console-tty-input-coding-system + (device-console) keyboard-coding-system))) (redraw-modeline t)) (defsubst terminal-coding-system () ＠＠ -120,8 +120,8 ＠＠ (setq terminal-coding-system coding-system) ; #### should this affect all current tty consoles ? (if (eq (device-type) 'tty) - (set-console-tty-output-coding-system - (device-console) terminal-coding-system)) + (declare-fboundp (set-console-tty-output-coding-system + (device-console) terminal-coding-system))) (redraw-modeline t)) (defun set-pathname-coding-system (coding-system) Index: lisp/faces.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/faces.el,v retrieving revision 1.18.2.23 diff -u -w -r1.18.2.23 faces.el --- faces.el 2001/01/15 18:32:46 1.18.2.23 +++ faces.el 2001/02/24 00:34:59 ＠＠ -1464,7 +1464,7 ＠＠ ((framep locale) (frame-type locale)) (t nil)))) (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype)) - (x-init-face-from-resources face locale)) + (declare-fboundp (x-init-face-from-resources face locale))) ((or (not devtype) (eq 'tty devtype)) ;; Nothing to do for TTYs? )))))) ＠＠ -1476,9 +1476,9 ＠＠ (init-face-from-resources face device)) ;; Then do any device-specific initialization. (cond ((eq 'x (device-type device)) - (x-init-device-faces device)) + (declare-fboundp (x-init-device-faces device))) ((eq 'mswindows (device-type device)) - (mswindows-init-device-faces device)) + (declare-fboundp (mswindows-init-device-faces device))) ;; Nothing to do for TTYs? ) (or (eq 'stream (device-type device)) ＠＠ -1491,9 +1491,9 ＠＠ (init-face-from-resources face frame)) ;; Then do any frame-specific initialization. (cond ((eq 'x (frame-type frame)) - (x-init-frame-faces frame)) + (declare-fboundp (x-init-frame-faces frame))) ((eq 'mswindows (frame-type frame)) - (mswindows-init-frame-faces frame)) + (declare-fboundp (mswindows-init-frame-faces frame))) ;; Is there anything which should be done for TTY's? ))) ＠＠ -1508,7 +1508,7 ＠＠ (loop for face in (face-list) do (init-face-from-resources face 'global)) ;; Further X frobbing. - (x-init-global-faces) + (declare-fboundp (x-init-global-faces)) ;; for bold and the like, make the global specification be bold etc. ;; if the user didn't already specify a value. These will also be ;; frobbed further in init-other-random-faces. ＠＠ -1663,9 +1663,10 ＠＠ in that frame; otherwise change each frame." (while (not (find-face face)) (setq face (wrong-type-argument 'facep face))) - (let ((bitmap-path (ecase (console-type) - (x x-bitmap-file-path) - (mswindows mswindows-bitmap-file-path))) + (let ((bitmap-path + (ecase (console-type) + (x (declare-boundp x-bitmap-file-path)) + (mswindows (declare-boundp mswindows-bitmap-file-path)))) instantiator) (while (null Index: lisp/files.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/files.el,v retrieving revision 1.27.2.29 diff -u -w -r1.27.2.29 files.el --- files.el 2000/11/06 05:44:18 1.27.2.29 +++ files.el 2001/02/24 00:35:00 ＠＠ -371,11 +371,22 ＠＠ ; (apply op args)) (defun convert-standard-filename (filename) - "Convert a standard file's name to something suitable for the current OS. -This function's standard definition is trivial; it just returns the argument. -However, on some systems, the function is redefined -with a definition that really does change some file names." - filename) + "Convert a standard file's name to something suitable for the current OS." + (if (eq system-type 'windows-nt) + (let ((name (copy-sequence filename)) + (start 0)) + ;; leave ':' if part of drive specifier + (if (eq (aref name 1) ?:) + (setq start 2)) + ;; destructively replace invalid filename characters with ! + (while (string-match "[?*:<>|\"\000-\037]" name start) + (aset name (match-beginning 0) ?!) + (setq start (match-end 0))) + ;; FSF: [convert directory separators to Windows format ...] + ;; unneeded in XEmacs. + name) + filename)) +  (defun pwd () "Show the current default directory." ＠＠ -1698,6 +1709,52 ＠＠ (t (make-local-variable var) (set var val))))  +(defun find-coding-system-magic-cookie-in-file (file) + "Look for the coding-system magic cookie in FILE. +The coding-system magic cookie is either the local variable specification +-*- ... coding: ... -*- on the first line, or the exact string +\";;;###coding system: \" somewhere within the first 3000 characters +of the file. If found, the coding system name (as a string) is returned; +otherwise nil is returned. Note that it is extremely unlikely that +either such string would occur coincidentally as the result of encoding +some characters in a non-ASCII charset, and that the spaces make it +even less likely since the space character is not a valid octet in any +ISO 2022 encoding of most non-ASCII charsets." + (save-excursion + (with-temp-buffer + (let ((coding-system-for-read 'raw-text)) + (insert-file-contents file nil 1 3001)) + (goto-char (point-min)) + (or (and (looking-at + "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-") + (buffer-substring (match-beginning 1) (match-end 1))) + ;; (save-excursion + ;; (let (start end) + ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t) + ;; (setq start (match-end 0)) + ;; (re-search-forward "\n;+[ \t]*End:") + ;; (setq end (match-beginning 0)) + ;; (save-restriction + ;; (narrow-to-region start end) + ;; (goto-char start) + ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t) + ;; ) + ;; (let ((codesys + ;; (intern (buffer-substring + ;; (match-beginning 1)(match-end 1))))) + ;; (if (find-coding-system codesys) codesys)) + ;; ))) + (let ((case-fold-search nil)) + (if (search-forward + ";;;###coding system: " (+ (point-min) 3000) t) + (let ((start (point)) + (end (progn + (skip-chars-forward "^ \t\n\r") + (point)))) + (if (> end start) (buffer-substring start end)) + ))) + )))) + (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 ＠＠ -1778,10 +1835,11 ＠＠ (kill-local-variable 'backup-inhibited) ;; If buffer was read-only because of version control, ;; that reason is gone now, so make it writable. - (when (boundp 'vc-mode) + (if-boundp 'vc-mode + (progn (if vc-mode (setq buffer-read-only nil)) - (kill-local-variable 'vc-mode)) + (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 buffer-file-name ＠＠ -1927,7 +1985,9 ＠＠ (setq setmodes (file-modes backupname))) (file-error ;; If trouble writing the backup, write it in ~. - (setq backupname (expand-file-name "~/%backup%~")) + (setq backupname + (expand-file-name + (convert-standard-filename "~/%backup%~"))) (message "Cannot write backup file; backing up in ~/%%backup%%~") (sleep-for 1) (condition-case () ＠＠ -2013,6 +2073,7 ＠＠ (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." + ;; FSF has code here for MS-DOS short filenames, not supported in XEmacs. (concat file "~")) (defun backup-file-name-p (file) ＠＠ -2040,6 +2101,7 ＠＠ Value is a list whose car is the name for the backup file and whose cdr is a list of old versions to consider deleting now. If the value is nil, don't make a backup." + (declare (special bv-length)) (let ((handler (find-file-name-handler fn 'find-backup-file-name))) ;; Run a handler for this function so that ange-ftp can refuse to do it. (if handler ＠＠ -2275,7 +2337,7 ＠＠ ;; delete it now. (delete-auto-save-file-if-necessary recent-save) ;; Support VC `implicit' locking. - (when (fboundp 'vc-after-save) + (if-fboundp 'vc-after-save (vc-after-save)) (run-hooks 'after-save-hook)) (display-message 'no-log "(No changes need to be saved)")))) ＠＠ -2462,9 +2524,10 ＠＠ ;; #### FSF has an EXIT-ACTION argument ;; to `view-buffer'. (view-buffer buf) + (with-boundp 'view-exit-action (setq view-exit-action (lambda (ignore) - (exit-recursive-edit))) + (exit-recursive-edit)))) (recursive-edit) ;; Return nil to ask about BUF again. nil) ＠＠ -2761,7 +2824,7 ＠＠ 'recover-file)))) (if handler (funcall handler 'recover-file file) - (if (auto-save-file-name-p file) + (if (auto-save-file-name-p (file-name-nondirectory file)) (error "%s is an auto-save file" file)) (let ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))) ＠＠ -2770,12 +2833,17 ＠＠ (not (file-exists-p file-name))) (error "Auto-save file %s not current" file-name)) ((save-window-excursion - (if (not (eq system-type 'windows-nt)) + ;; XEmacs change: use insert-directory instead of + ;; calling ls directly. (with-output-to-temp-buffer "*Directory*" (buffer-disable-undo standard-output) - (call-process "ls" nil standard-output nil - (if (file-symlink-p file) "-lL" "-l") - file file-name))) + (save-excursion + (set-buffer "*Directory*") + (setq default-directory (file-name-directory file)) + (insert-directory file + (if (file-symlink-p file) "-lL" "-l")) + (setq default-directory (file-name-directory file-name)) + (insert-directory file-name "-l"))) (yes-or-no-p (format "Recover auto save file %s? " file-name))) (switch-to-buffer (find-file-noselect file t)) (let ((buffer-read-only nil)) ＠＠ -2941,72 +3009,9 ＠＠ (recent-auto-save-p)) (rename-file osave buffer-auto-save-file-name t)))) -;; see also ../packages/auto-save.el -(defun make-auto-save-file-name (&optional filename) - "Return file name to use for auto-saves of current buffer. -Does not consider `auto-save-visited-file-name' as that variable is checked -before calling this function. You can redefine this for customization. -See also `auto-save-file-name-p'." - (let ((fname (or filename buffer-file-name)) - name) - (setq name - (if fname - (concat (file-name-directory fname) - "#" - (file-name-nondirectory fname) - "#") - - ;; Deal with buffers that don't have any associated files. (Mail - ;; mode tends to create a good number of these.) - - (let ((buffer-name (buffer-name)) - (limit 0)) - ;; Use technique from Sebastian Kremer's auto-save - ;; package to turn slashes into \\!. This ensures that - ;; the auto-save buffer name is unique. - - ;; #### - yuck! yuck! yuck! move this functionality - ;; somewhere else and make the name translation customizable. - ;; Using "\!" as part of a filename on a UNIX filesystem is nearly - ;; IMPOSSIBLE to get past a shell parser. -stig - - (while (string-match "[/\\]" buffer-name limit) - (setq buffer-name - (concat (substring buffer-name 0 (match-beginning 0)) - (if (string= (substring buffer-name - (match-beginning 0) - (match-end 0)) - "/") - "\\!" - "\\\\") - (substring buffer-name (match-end 0)))) - (setq limit (1+ (match-end 0)))) - - ;; (expand-file-name (format "#%s#%s#" (buffer-name) (make-temp-name ""))) - - ;; jwz: putting the emacs PID in the auto-save file name - ;; is bad news, because that defeats auto-save-recovery of - ;; *mail* buffers -- the (sensible) code in sendmail.el - ;; calls (make-auto-save-file-name) to determine whether - ;; there is unsent, auto-saved mail to recover. If that - ;; mail came from a previous emacs process (far and away - ;; the most likely case) then this can never succeed as - ;; the pid differs. +;; make-auto-save-file-name and auto-save-file-name-p are now only in +;; auto-save.el. - (expand-file-name (format "#%s#" buffer-name))) - )) - ;; don't try to write auto-save files in unwritable places. Unless - ;; there's already an autosave file here, put ours somewhere safe. --Stig - (if (or (file-writable-p name) - (file-exists-p name)) - name - (expand-file-name (concat "~/" (file-name-nondirectory name)))))) - -(defun auto-save-file-name-p (filename) - "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. -FILENAME should lack slashes. -You can redefine this for customization." - (string-match "\\`#.*#\\'" filename))  (defun wildcard-to-regexp (wildcard) "Given a shell file name pattern WILDCARD, return an equivalent regexp. ＠＠ -3150,8 +3155,9 ＠＠ (funcall handler 'insert-directory file switches wildcard full-directory-p) (cond - ;; #### mswindows-insert-directory should be called - ;; nt-insert-directory - kkm. + ;; [mswindows-insert-directory should be called + ;; nt-insert-directory - kkm]. not true any more according to + ;; my new naming scheme. --ben ((and (fboundp 'mswindows-insert-directory) (eq system-type 'windows-nt)) (mswindows-insert-directory file switches wildcard full-directory-p)) ＠＠ -3265,8 +3271,10 ＠＠ (defun file-remote-p (file-name) "Test whether FILE-NAME is looked for on a remote system." (cond ((not allow-remote-paths) nil) - ((featurep 'ange-ftp) (ange-ftp-ftp-path file-name)) - ((fboundp 'efs-ftp-path) (efs-ftp-path file-name)) + ((fboundp 'ange-ftp-ftp-path) + (declare-fboundp (ange-ftp-ftp-path file-name))) + ((fboundp 'efs-ftp-path) + (declare-fboundp (efs-ftp-path file-name))) (t nil))) ;; #### FSF has file-name-non-special here. Index: lisp/fill.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/fill.el,v retrieving revision 1.3.2.7 diff -u -w -r1.3.2.7 fill.el --- fill.el 2000/11/06 05:44:16 1.3.2.7 +++ fill.el 2001/02/24 00:35:01 ＠＠ -128,7 +128,7 ＠＠ (forward-char -1) (if (< (point) opoint) (forward-char)))) - (if (featurep 'mule) (kinsoku-process-extend))) + (if (featurep 'mule) (declare-fboundp (kinsoku-process-extend)))) (defun fill-end-of-sentence-p () (save-excursion ＠＠ -458,7 +458,7 ＠＠ ;; 97/3/14 jhod: Kinsoku ;(skip-chars-backward "^ \n" linebeg))) (fill-move-backward-to-break-point re-break-point linebeg))) - (if (featurep 'mule) (kinsoku-process)) + (if (featurep 'mule) (declare-fboundp (kinsoku-process))) ;end patch ;; If the left margin and fill prefix by themselves ＠＠ -662,14 +662,13 ＠＠ (fill-region-as-paragraph (point) end justify nosqueeze) (goto-char end))))))) -;; XEmacs addition: from Tim Bradshaw <tfb(a)edinburgh.ac.uk&gt; (defun fill-paragraph-or-region (arg) "Fill the current region, if it's active; otherwise, fill the paragraph. See `fill-paragraph' and `fill-region' for more information." (interactive "*P") (if (region-active-p) - (fill-region (point) (mark) arg) - (fill-paragraph arg))) + (call-interactively 'fill-region) + (call-interactively 'fill-paragraph)))  (defconst default-justification 'left ＠＠ -787,7 +786,7 ＠＠ (defun find-space-insertable-point () "Search backward for a permissible point for inserting justification spaces." (if (boundp 'space-insertable) - (if (re-search-backward space-insertable nil t) + (if (re-search-backward (declare-boundp space-insertable) nil t) (progn (forward-char 1) t) nil) Index: lisp/font.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/font.el,v retrieving revision 1.5.2.4 diff -u -w -r1.5.2.4 font.el --- font.el 2000/11/06 05:44:06 1.5.2.4 +++ font.el 2001/02/24 00:35:01 ＠＠ -75,13 +75,7 ＠＠ (require 'disp-table) -(if (not (fboundp '<<)) (fset '<< 'lsh)) -(if (not (fboundp '&)) (fset '& 'logand)) -(if (not (fboundp '|)) (fset '| 'logior)) -(if (not (fboundp '~)) (fset '~ 'lognot)) -(if (not (fboundp '>>)) (defun >> (value count) (<< value (- count)))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Lots of variables / keywords for use later in the program ;;; Not much should need to be modified ＠＠ -149,40 +143,40 ＠＠ (defvar font-style-keywords nil) -(defsubst set-font-family (fontobj family) +(defun set-font-family (fontobj family) (aset fontobj 1 family)) -(defsubst set-font-weight (fontobj weight) +(defun set-font-weight (fontobj weight) (aset fontobj 3 weight)) -(defsubst set-font-style (fontobj style) +(defun set-font-style (fontobj style) (aset fontobj 5 style)) -(defsubst set-font-size (fontobj size) +(defun set-font-size (fontobj size) (aset fontobj 7 size)) -(defsubst set-font-registry (fontobj reg) +(defun set-font-registry (fontobj reg) (aset fontobj 9 reg)) -(defsubst set-font-encoding (fontobj enc) +(defun set-font-encoding (fontobj enc) (aset fontobj 11 enc)) -(defsubst font-family (fontobj) +(defun font-family (fontobj) (aref fontobj 1)) -(defsubst font-weight (fontobj) +(defun font-weight (fontobj) (aref fontobj 3)) -(defsubst font-style (fontobj) +(defun font-style (fontobj) (aref fontobj 5)) -(defsubst font-size (fontobj) +(defun font-size (fontobj) (aref fontobj 7)) -(defsubst font-registry (fontobj) +(defun font-registry (fontobj) (aref fontobj 9)) -(defsubst font-encoding (fontobj) +(defun font-encoding (fontobj) (aref fontobj 11)) (eval-when-compile ＠＠ -194,13 +188,13 ＠＠ (quote ,(intern (format "set-font-%s-p" attr))) (quote ,(intern (format "font-%s-p" attr))))) font-style-keywords)) - (defconst ,(intern (format "font-%s-mask" attr)) (<< 1 ,mask) + (defconst ,(intern (format "font-%s-mask" attr)) (lsh 1 ,mask) ,(format "Bitmask for whether a font is to be rendered in %s or not." attr)) (defun ,(intern (format "font-%s-p" attr)) (fontobj) ,(format "Whether FONTOBJ will be renderd in `%s' or not." attr) - (if (/= 0 (& (font-style fontobj) + (if (/= 0 (logand (font-style fontobj) ,(intern (format "font-%s-mask" attr)))) t nil)) ＠＠ -209,7 +203,7 ＠＠ attr) (cond (val - (set-font-style fontobj (| (font-style fontobj) + (set-font-style fontobj (logior (font-style fontobj) ,(intern (format "font-%s-mask" attr))))) ((,(intern (format "font-%s-p" attr)) fontobj) ＠＠ -254,7 +248,7 ＠＠ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defsubst set-font-style-by-keywords (fontobj styles) +(defun set-font-style-by-keywords (fontobj styles) (make-local-variable 'font-func) (declare (special font-func)) (if (listp styles) ＠＠ -265,9 +259,8 ＠＠ (setq font-func (car-safe (cdr-safe (assq styles font-style-keywords)))) (and (fboundp font-func) (funcall font-func fontobj t)))) -(defsubst font-properties-from-style (fontobj) - (let ((style (font-style fontobj)) - (todo font-style-keywords) +(defun font-properties-from-style (fontobj) + (let ((todo font-style-keywords) type func retval) (while todo (setq func (cdr (cdr (car todo))) ＠＠ -394,7 +387,8 ＠＠ (font-weight fontobj-2))) (set-font-family retval (font-unique (append (font-family fontobj-1) (font-family fontobj-2)))) - (set-font-style retval (| (font-style fontobj-1) (font-style fontobj-2))) + (set-font-style retval (logior (font-style fontobj-1) + (font-style fontobj-2))) (set-font-registry retval (or (font-registry fontobj-1) (font-registry fontobj-2))) (set-font-encoding retval (or (font-encoding fontobj-1) ＠＠ -454,9 +448,9 ＠＠ ((- "[-?]") (foundry "[^-]*") (family "[^-]*") - (weight "\\(bold\\|demibold\\|medium\\|black\\)") + ;(weight "\\(bold\\|demibold\\|medium\\|black\\)") (weight\? "\\([^-]*\\)") - (slant "\\([ior]\\)") + ;(slant "\\([ior]\\)") (slant\? "\\([^-]?\\)") (swidth "\\([^-]*\\)") (adstyle "\\([^-]*\\)") ＠＠ -523,7 +517,6 ＠＠ (not (string-match font-x-font-regexp fontname))) (make-font) (let ((family nil) - (style nil) (size nil) (weight (match-string 1 fontname)) (slant (match-string 2 fontname)) ＠＠ -634,7 +627,6 ＠＠ (font-family default) (x-font-families-for-device device))) (weight (or (font-weight fontobj) :medium)) - (style (font-style fontobj)) (size (or (if font-running-xemacs (font-size fontobj)) (font-size default))) ＠＠ -717,9 +709,7 ＠＠ (ns-font-families-for-device device))) (weight (or (font-weight fontobj) :medium)) (style (or (font-style fontobj) (list :normal))) - (size (font-size fontobj)) - (registry (or (font-registry fontobj) "*")) - (encoding (or (font-encoding fontobj) "*"))) + (size (font-size fontobj))) ;; Create a font, wow! (if (stringp family) (setq family (list family))) ＠＠ -863,7 +853,6 ＠＠ (family (or (font-family fontobj) (font-family default))) (weight (or (font-weight fontobj) :regular)) - (style (font-style fontobj)) (size (or (if font-running-xemacs (font-size fontobj)) (font-size default))) ＠＠ -996,7 +985,6 ＠＠ ;; create-device-hook. This is XEmacs 19.12+ specific (let ((faces (face-list 2)) (cur nil) - (font nil) (font-spec nil)) (while faces (setq cur (car faces) ＠＠ -1012,8 +1000,7 ＠＠ (if (devicep device-list) (setq device-list (list device-list))) (let* ((cur-device nil) - (font-spec (face-property face 'font-specification)) - (font nil)) + (font-spec (face-property face 'font-specification))) (if (not font-spec) ;; Hey! Don't mess with fonts we didn't create in the ;; first place. ＠＠ -1189,14 +1176,14 ＠＠ b 0))) (list r g b) )) -(defsubst font-rgb-color-p (obj) +(defun font-rgb-color-p (obj) (or (and (vectorp obj) (= (length obj) 4) (eq (aref obj 0) 'rgb)))) -(defsubst font-rgb-color-red (obj) (aref obj 1)) -(defsubst font-rgb-color-green (obj) (aref obj 2)) -(defsubst font-rgb-color-blue (obj) (aref obj 3)) +(defun font-rgb-color-red (obj) (aref obj 1)) +(defun font-rgb-color-green (obj) (aref obj 2)) +(defun font-rgb-color-blue (obj) (aref obj 3)) (defun font-color-rgb-components (color) "Return the RGB components of COLOR as a list of integers (R G B). ＠＠ -1237,7 +1224,7 ＠＠ (t (font-lookup-rgb-components color))))) -(defsubst font-tty-compute-color-delta (col1 col2) +(defun font-tty-compute-color-delta (col1 col2) (+ (* (- (aref col1 0) (aref col2 0)) (- (aref col1 0) (aref col2 0))) ＠＠ -1295,7 +1282,7 ＠＠ (tty (apply 'font-tty-find-closest-color (font-color-rgb-components color))) (ns - (let ((vals (mapcar #'(lambda (x) (>> x 8)) + (let ((vals (mapcar #'(lambda (x) (lsh x -8)) (font-color-rgb-components color)))) (apply 'format "RGB%02x%02x%02xff" vals))) (otherwise Index: lisp/frame.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/frame.el,v retrieving revision 1.16.2.3 diff -u -w -r1.16.2.3 frame.el --- frame.el 2000/11/06 05:44:07 1.16.2.3 +++ frame.el 2001/02/24 00:35:02 ＠＠ -781,7 +781,8 ＠＠ (cond ((device-on-window-system-p) (iconify-emacs)) ((and (eq (device-type) 'tty) - (console-tty-controlling-process (selected-console))) + (declare-fboundp (console-tty-controlling-process + (selected-console)))) (suspend-console (selected-console))) (t (suspend-emacs)))) ＠＠ -796,7 +797,8 ＠＠ (cond ((device-on-window-system-p) (iconify-frame)) ((and (eq (frame-type) 'tty) - (console-tty-controlling-process (selected-console))) + (declare-fboundp (console-tty-controlling-process + (selected-console)))) (suspend-console (selected-console))) (t (suspend-emacs)))) Index: lisp/gpm.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/Attic/gpm.el,v retrieving revision 1.1.2.3 diff -u -w -r1.1.2.3 gpm.el --- gpm.el 2000/09/13 10:56:25 1.1.2.3 +++ gpm.el 2001/02/24 00:35:02 ＠＠ -31,6 +31,7 ＠＠ "Toggle GPM mouse mode. With prefix arg, turn GPM mouse mode on if and only if arg is positive." (interactive (list current-prefix-arg (selected-device))) + (with-fboundp 'gpm-enable (cond ((null arg) ; Toggle (if (gethash device gpm-enabled-devices) ＠＠ -44,7 +45,7 ＠＠ (puthash device t gpm-enabled-devices)) ((gethash device gpm-enabled-devices) ; Turn off (gpm-enable device nil) - (remhash device gpm-enabled-devices)))) + (remhash device gpm-enabled-devices))))) (defun turn-on-gpm-mouse-tracking (&optional device) ;; Enable mouse tracking on linux console ＠＠ -54,22 +55,24 ＠＠ ;; Disable mouse tracking on linux console (gpm-mode -5 device)) -(defun gpm-create-device-hook (device) - (if (and (not noninteractive) ; Don't want to do this in batch mode +(defun gpm-is-supported-p (device) + "Returns non-nil if GPM is usable right now on DEVICE in this XEmacs session. +This checks whether GPM support was compiled in, TTY support was +compiled in, XEmacs is running on Linux, the current console/device is +TTY, and its terminal type has been set to `linux'." + (and (not noninteractive) ; Don't want to do this in batch mode (fboundp 'gpm-enable) ; Must have C-level GPM support (eq system-type 'linux) ; Must be running linux (eq (device-type device) 'tty) ; on a tty - (equal "linux" (console-tty-terminal-type ; an a linux terminal type - (device-console device)))) + (equal "linux" (declare-fboundp ; an a linux terminal type + (console-tty-terminal-type (device-console device)))))) + +(defun gpm-create-device-hook (device) + (if (gpm-is-supported-p device) (turn-on-gpm-mouse-tracking device))) (defun gpm-delete-device-hook (device) - (if (and (not noninteractive) ; Don't want to do this in batch mode - (fboundp 'gpm-enable) ; Must have C-level GPM support - (eq system-type 'linux) ; Must be running linux - (eq (device-type device) 'tty) ; on a tty - (equal "linux" (console-tty-terminal-type ; an a linux terminal type - (device-console device)))) + (if (gpm-is-supported-p device) (turn-off-gpm-mouse-tracking device))) ;; Restore normal mouse behavior outside Emacs Index: lisp/help.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/help.el,v retrieving revision 1.26.2.19 diff -u -w -r1.26.2.19 help.el --- help.el 2001/01/24 09:13:49 1.26.2.19 +++ help.el 2001/02/24 00:35:02 ＠＠ -1,6 +1,7 ＠＠ ;;; help.el --- help commands for XEmacs. ;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc. +;; Copyright (C) 2001 Ben Wing. ;; Maintainer: FSF ;; Keywords: help, internal, dumped ＠＠ -63,118 +64,76 ＠＠ (define-key help-map 'help 'help-for-help) (define-key help-map '(f1) 'help-for-help) -(define-key help-map "\C-l" 'describe-copying) ; on \C-c in FSFmacs -(define-key help-map "\C-d" 'describe-distribution) -(define-key help-map "\C-w" 'describe-no-warranty) (define-key help-map "a" 'hyper-apropos) ; 'command-apropos in FSFmacs (define-key help-map "A" 'command-apropos) +(define-key help-map "\C-a" 'apropos-documentation) (define-key help-map "b" 'describe-bindings) (define-key help-map "B" 'describe-beta) -(define-key help-map "\C-p" 'describe-pointer) -(define-key help-map "C" 'customize) (define-key help-map "c" 'describe-key-briefly) -(define-key help-map "k" 'describe-key) +(define-key help-map "C" 'customize) +;; FSFmacs has Info-goto-emacs-command-node on C-f, no binding +;; for Info-elisp-ref +(define-key help-map "\C-c" 'Info-goto-emacs-command-node) (define-key help-map "d" 'describe-function) -(define-key help-map "e" 'describe-last-error) -(define-key help-map "f" 'describe-function) +(define-key help-map "\C-d" 'describe-distribution) +(define-key help-map "e" (if (fboundp 'view-last-error) 'view-last-error + 'describe-last-error)) + +(define-key help-map "f" 'describe-function) +;; #### not a good interface. no way to specify that C-h is preferred +;; as a prefix and not BS. should instead be specified as part of +;; `define-key'. +;; (put 'describe-function 'preferred-key-sequence "\C-hf") (define-key help-map "F" 'xemacs-local-faq) +(define-key help-map "\C-f" 'Info-elisp-ref) (define-key help-map "i" 'info) -(define-key help-map '(control i) 'Info-query) -;; FSFmacs has Info-goto-emacs-command-node on C-f, no binding -;; for Info-elisp-ref -(define-key help-map '(control c) 'Info-goto-emacs-command-node) -(define-key help-map '(control k) 'Info-goto-emacs-key-command-node) -(define-key help-map '(control f) 'Info-elisp-ref) +(define-key help-map "I" 'Info-search-index-in-xemacs-and-lispref) +(define-key help-map "\C-i" 'Info-query) + +(define-key help-map "k" 'describe-key) +(define-key help-map "\C-k" 'Info-goto-emacs-key-command-node) (define-key help-map "l" 'view-lossage) +(define-key help-map "\C-l" 'describe-copying) ; on \C-c in FSFmacs (define-key help-map "m" 'describe-mode) -(define-key help-map "\C-n" 'view-emacs-news) (define-key help-map "n" 'view-emacs-news) +(define-key help-map "\C-n" 'view-emacs-news) (define-key help-map "p" 'finder-by-keyword) +(define-key help-map "\C-p" 'describe-pointer) +(define-key help-map "q" 'help-quit) + ;; Do this right with an autoload cookie in finder.el. ;;(autoload 'finder-by-keyword "finder" ;; "Find packages matching a given keyword." t) (define-key help-map "s" 'describe-syntax) +(define-key help-map "S" 'view-sample-init-el) (define-key help-map "t" 'help-with-tutorial) -(define-key help-map "w" 'where-is) - (define-key help-map "v" 'describe-variable) - -(if (fboundp 'view-last-error) - (define-key help-map "e" 'view-last-error)) - -(define-key help-map "q" 'help-quit) - -;#### This stuff was an attempt to have font locking and hyperlinks in the -;help buffer, but it doesn't really work. Some of this stuff comes from -;FSF Emacs; but the FSF Emacs implementation is rather broken, as usual. -;What needs to happen is this: -; -; -- we probably need a "hyperlink mode" from which help-mode is derived. -; -- this means we probably need multiple inheritance of modes! -; Thankfully this is not hard to implement; we already have the -; ability for a keymap to have multiple parents. However, we'd -; have to define any multiply-inherited-from modes using a standard -; `define-mode' construction instead of manually doing it, because -; we don't want each guy calling `kill-all-local-variables' and -; messing up the previous one. -; -- we need to scan the buffer ourselves (not from font-lock, because -; the user might not have font-lock enabled) and highlight only -; those words that are *documented* functions and variables (and -; probably excluding words without dashes in them unless enclosed -; in quotes, so that common words like "list" and "point" don't -; become hyperlinks. -; -- we should *not* use font-lock keywords like below. Instead we -; should add the font-lock stuff ourselves during the scanning phase, -; if font-lock is enabled in this buffer. - -;(defun help-follow-reference (event extent user-data) -; (let ((symbol (intern-soft (extent-string extent)))) -; (cond ((and symbol (fboundp symbol)) -; (describe-function symbol)) -; ((and symbol (boundp symbol)) -; (describe-variable symbol)) -; (t nil)))) - -;(defvar help-font-lock-keywords -; (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]")) -; (list -; ;; -; ;; The symbol itself. -; (list (concat "\\`\\(" name-char "+\\)\\(:\\)?") -; '(1 (if (match-beginning 2) -; 'font-lock-function-name-face -; 'font-lock-variable-name-face) -; nil t)) -; ;; -; ;; Words inside `' which tend to be symbol names. -; (list (concat "`\\(" sym-char sym-char "+\\)'") -; 1 '(prog1 -; 'font-lock-reference-face -; (add-list-mode-item (match-beginning 1) -; (match-end 1) -; nil -; 'help-follow-reference)) -; t) -; ;; -; ;; CLisp `:' keywords as references. -; (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))) -; "Default expressions to highlight in Help mode.") +(define-key help-map "w" 'where-is) +(define-key help-map "\C-w" 'describe-no-warranty) -;(put 'help-mode 'font-lock-defaults '(help-font-lock-keywords)) +;; #### It would be nice if the code below to add hyperlinks was +;; generalized. We would probably need a "hyperlink mode" from which +;; help-mode is derived. This means we probably need multiple +;; inheritance of modes! Thankfully this is not hard to implement; we +;; already have the ability for a keymap to have multiple parents. +;; However, we'd have to define any multiply-inherited-from modes using +;; a standard `define-mode' construction instead of manually doing it, +;; because we don't want each guy calling `kill-all-local-variables' and +;; messing up the previous one. (define-derived-mode help-mode view-major-mode "Help" "Major mode for viewing help text. ＠＠ -264,41 +223,9 ＠＠ ;;(define-key global-map 'backspace 'deprecated-help-command) -;; This function has been moved to help-nomule.el and mule-help.el. -;; TUTORIAL arg is XEmacs addition -;(defun help-with-tutorial (&optional tutorial) -; "Select the XEmacs learn-by-doing tutorial. -;Optional arg TUTORIAL specifies the tutorial file; default is \"TUTORIAL\"." -; (interactive) -; (if (null tutorial) -; (setq tutorial "TUTORIAL")) -; (let ((file (expand-file-name (concat "~/" tutorial)))) -; (delete-other-windows) -; (if (get-file-buffer file) -; (switch-to-buffer (get-file-buffer file)) -; (switch-to-buffer (create-file-buffer file)) -; (setq buffer-file-name file) -; (setq default-directory (expand-file-name "~/")) -; (setq buffer-auto-save-file-name nil) -; (insert-file-contents (expand-file-name tutorial data-directory)) -; (goto-char (point-min)) -; (search-forward "\n<<") -; (delete-region (point-at-bol) (point-at-eol)) -; (let ((n (- (window-height (selected-window)) -; (count-lines (point-min) (point)) -; 6))) -; (if (< n 12) -; (newline n) -; ;; Some people get confused by the large gap. -; (newline (/ n 2)) -; (insert "[Middle of page left blank for didactic purposes. " -; "Text continues below]") -; (newline (- n (/ n 2))))) -; (goto-char (point-min)) -; (set-buffer-modified-p nil)))) +;; help-with-tutorial moved to help-nomule.el and mule-help.el. ;; used by describe-key, describe-key-briefly, insert-key-binding, etc. - (defun key-or-menu-binding (key &optional menu-flag) "Return the command invoked by KEY. Like `key-binding', but handles menu events and toolbar presses correctly. ＠＠ -620,25 +547,27 ＠＠ ;; So keyboard macro definitions are documented correctly (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) +;; view a read-only file intelligently +(defun Help-find-file (file) + (if (fboundp 'view-file) + (view-file file) + (find-file-read-only file) + (goto-char (point-min)))) + (defun describe-distribution () "Display info on how to obtain the latest version of XEmacs." (interactive) - (find-file-read-only - (locate-data-file "DISTRIB"))) + (Help-find-file (locate-data-file "DISTRIB"))) (defun describe-beta () "Display info on how to deal with Beta versions of XEmacs." (interactive) - (find-file-read-only - (locate-data-file "BETA")) - (goto-char (point-min))) + (Help-find-file (locate-data-file "BETA"))) (defun describe-copying () "Display info on how you may redistribute copies of XEmacs." (interactive) - (find-file-read-only - (locate-data-file "COPYING")) - (goto-char (point-min))) + (Help-find-file (locate-data-file "COPYING"))) (defun describe-pointer () "Show a list of all defined mouse buttons, and their definitions." ＠＠ -648,9 +577,7 ＠＠ (defun describe-project () "Display info on the GNU project." (interactive) - (find-file-read-only - (locate-data-file "GNU")) - (goto-char (point-min))) + (Help-find-file (locate-data-file "GNU"))) (defun describe-no-warranty () "Display info on all the kinds of warranty XEmacs does NOT have." ＠＠ -762,7 +689,7 ＠＠ (defun view-emacs-news () "Display info on recent changes to XEmacs." (interactive) - (find-file (locate-data-file "NEWS"))) + (Help-find-file (locate-data-file "NEWS"))) (defun xemacs-www-page () "Go to the XEmacs World Wide Web page." ＠＠ -788,6 +715,11 ＠＠ (Info-find-node "xemacs-faq" "Top")) (switch-to-buffer "*info*")) +(defun view-sample-init-el () + "Display the sample init.el file." + (interactive) + (Help-find-file (locate-data-file "sample.init.el"))) + (defcustom view-lossage-key-count 100 "*Number of keys `view-lossage' shows. The maximum number of available keys is governed by `recent-keys-ring-size'." ＠＠ -845,41 +777,68 ＠＠ (make-help-screen help-for-help "A B C F I K L M N P S T V W C-c C-d C-f C-i C-k C-n C-w; ? for more help:" + (concat "Type a Help option: \(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.) +Help on key bindings: + +\\[describe-bindings] Table of all key bindings. +\\[describe-key-briefly] Type a key sequence or select a menu item; + it displays the corresponding command name. +\\[describe-key] Type a key sequence or select a menu item; + it displays the documentation for the command bound to that key. + (Terser but more up-to-date than what's in the manual.) +\\[Info-goto-emacs-key-command-node] Type a key sequence or select a menu item; + it jumps to the full documentation in the XEmacs User's Manual + for the corresponding command. +\\[view-lossage] Recent input keystrokes and minibuffer messages. +\\[describe-mode] Documentation of current major and minor modes. +\\[describe-pointer] Table of all mouse-button bindings. +\\[where-is] Type a command name; it displays which keystrokes invoke that command. + +Help on functions and variables: + \\[hyper-apropos] Type a substring; it shows a hypertext list of functions and variables that contain that substring. - See also the `apropos' command. -\\[command-apropos] Type a substring; it shows a list of commands - (interactively callable functions) that contain that substring. -\\[describe-bindings] Table of all key bindings. -\\[describe-key-briefly] Type a command key sequence; - it displays the function name that sequence runs. -\\[customize] Customize Emacs options. -\\[Info-goto-emacs-command-node] Type a function name; it displays the Info node for that command. -\\[describe-function] Type a function name; it shows its documentation. +\\[command-apropos] Older version of apropos; superseded by previous command. +\\[apropos-documentation] Type a substring; it shows a hypertext list of + functions and variables containing that substring anywhere + in their documentation. +\\[Info-goto-emacs-command-node] Type a command name; it jumps to the full documentation + in the XEmacs User's Manual. +\\[describe-function] Type a command or function name; it shows its documentation. + (Terser but more up-to-date than what's in the manual.) \\[Info-elisp-ref] Type a function name; it jumps to the full documentation - in the XEmacs Lisp Programmer's Manual. + in the XEmacs Lisp Reference Manual. +\\[Info-search-index-in-xemacs-and-lispref] Type a substring; it looks it up in the indices of both + the XEmacs User's Manual and the XEmacs Lisp Reference Manual. + It jumps to the first match (preferring an exact match); you + can use `\\<Info-mode-map>\\[Info-index-next]\\<help-map>' to successively visit other matches. +\\[describe-variable] Type a variable name; it displays its documentation and value. + +Miscellaneous: + +" + (if (string-match "beta" emacs-version) +"\\[describe-beta] Special considerations about running a beta version of XEmacs. +" +"") +" +\\[customize] Customize Emacs options. +\\[describe-distribution] How to obtain XEmacs. +\\[describe-last-error] Information about the most recent error. \\[xemacs-local-faq] Local copy of the XEmacs FAQ. \\[info] Info documentation reader. \\[Info-query] Type an Info file name; it displays it in Info reader. -\\[describe-key] Type a command key sequence; - it displays the documentation for the command bound to that key. -\\[Info-goto-emacs-key-command-node] Type a command key sequence; - it displays the Info node for the command bound to that key. -\\[view-lossage] Recent input keystrokes and minibuffer messages. -\\[describe-mode] Documentation of current major and minor modes. +\\[describe-copying] XEmacs copying permission (General Public License). \\[view-emacs-news] News of recent XEmacs changes. \\[finder-by-keyword] Type a topic keyword; it finds matching packages. -\\[describe-pointer] Table of all mouse-button bindings. \\[describe-syntax] Contents of syntax table with explanations. +\\[view-sample-init-el] View the sample init.el that comes with XEmacs. \\[help-with-tutorial] XEmacs learn-by-doing tutorial. -\\[describe-variable] Type a variable name; it displays its documentation and value. -\\[where-is] Type a command name; it displays which keystrokes invoke that command. -\\[describe-distribution] XEmacs ordering information. -\\[describe-no-warranty] Information on absence of warranty for XEmacs. -\\[describe-copying] XEmacs copying permission (General Public License)." +\\[describe-no-warranty] Information on absence of warranty for XEmacs." +) help-map) (defmacro with-syntax-table (syntab &rest body) ＠＠ -1124,6 +1083,38 ＠＠ ; ;; CLisp `:' keywords as references. ; (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))) +;; replacement for `princ' that puts the text in the specified face, +;; if possible +(defun Help-princ-face (object face) + (cond ((bufferp standard-output) + (let ((opoint (point standard-output))) + (princ object) + (put-nonduplicable-text-property opoint (point standard-output) + 'face face standard-output))) + ((markerp standard-output) + (let ((buf (marker-buffer standard-output)) + (pos (marker-position standard-output))) + (princ object) + (put-nonduplicable-text-property + pos (marker-position standard-output) 'face face buf))) + (t princ object))) + +;; replacement for `prin1' that puts the text in the specified face, +;; if possible +(defun Help-prin1-face (object face) + (cond ((bufferp standard-output) + (let ((opoint (point standard-output))) + (prin1 object) + (put-nonduplicable-text-property opoint (point standard-output) + 'face face standard-output))) + ((markerp standard-output) + (let ((buf (marker-buffer standard-output)) + (pos (marker-position standard-output))) + (prin1 object) + (put-nonduplicable-text-property + pos (marker-position standard-output) 'face face buf))) + (t prin1 object))) + (defvar help-symbol-regexp (let ((sym-char "[+a-zA-Z0-9_:*]") (sym-char-no-dash "[-+a-zA-Z0-9_:*]")) ＠＠ -1151,25 +1142,25 ＠＠ (help-symbol-run-function-1 last-popup-menu-event ex fun)))) (defvar help-symbol-function-context-menu - '("---" - ["View %_Documentation" (help-symbol-run-function 'describe-function)] + '(["View %_Documentation" (help-symbol-run-function 'describe-function)] ["Find %_Function Source" (help-symbol-run-function 'find-function)] + ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) (defvar help-symbol-variable-context-menu - '("---" - ["View %_Documentation" (help-symbol-run-function 'describe-variable)] + '(["View %_Documentation" (help-symbol-run-function 'describe-variable)] ["Find %_Variable Source" (help-symbol-run-function 'find-variable)] + ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) (defvar help-symbol-function-and-variable-context-menu - '("---" - ["View Function %_Documentation" (help-symbol-run-function + '(["View Function %_Documentation" (help-symbol-run-function 'describe-function)] ["View Variable D%_ocumentation" (help-symbol-run-function 'describe-variable)] ["Find %_Function Source" (help-symbol-run-function 'find-function)] ["Find %_Variable Source" (help-symbol-run-function 'find-variable)] + ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) (defun frob-help-extents (buffer) ＠＠ -1179,9 +1170,10 ＠＠ ;; properties: ;; 1. mouse-face is 'highlight (so the extent gets highlighted on mouse over) ;; 2. help-symbol is the name of the symbol. - ;; 3. context-menu is a list of context menu items, specific to whether + ;; 3. face is 'font-lock-reference-face. + ;; 4. context-menu is a list of context menu items, specific to whether ;; the symbol is a function, variable, or both. - ;; 4. activate-function will cause the function or variable to be described, + ;; 5. activate-function will cause the function or variable to be described, ;; replacing the existing help contents. (save-excursion (set-buffer buffer) ＠＠ -1200,6 +1192,7 ＠＠ (let ((ex (make-extent b e))) (set-extent-property ex 'mouse-face 'highlight) (set-extent-property ex 'help-symbol sym) + (set-extent-property ex 'face 'font-lock-reference-face) (set-extent-property ex 'context-menu (cond ((and var fun) ＠＠ -1217,7 +1210,10 ＠＠ (defun describe-function-1 (function &optional nodoc) "This function does the work for `describe-function'." - (princ (format "`%s' is " function)) + (princ "`") + ;; (Help-princ-face function 'font-lock-function-name-face) overkill + (princ function) + (princ "' is ") (let* ((def function) aliases file-name autoload-file kbd-macro-p fndef macrop) (while (and (symbolp def) (fboundp def)) ＠＠ -1233,12 +1229,13 ＠＠ (setq def (symbol-function def))) (if (and (fboundp 'compiled-function-annotation) (compiled-function-p def)) - (setq file-name (compiled-function-annotation def))) + (setq file-name (declare-fboundp (compiled-function-annotation def)))) (if (eq 'macro (car-safe def)) (setq fndef (cdr def) file-name (and (compiled-function-p (cdr def)) (fboundp 'compiled-function-annotation) - (compiled-function-annotation (cdr def))) + (declare-fboundp + (compiled-function-annotation (cdr def)))) macrop t) (setq fndef def)) (if aliases (princ aliases)) ＠＠ -1281,7 +1278,7 ＠＠ (if describe-function-show-arglist (let ((arglist (function-arglist function))) (when arglist - (princ arglist) + (Help-princ-face arglist 'font-lock-comment-face) (terpri)))) (terpri) (cond (kbd-macro-p ＠＠ -1421,7 +1418,11 ＠＠ (let ((origvar variable) aliases) (let ((print-escape-newlines t)) - (princ (format "`%s' is " (symbol-name variable))) + (princ "`") + ;; (Help-princ-face (symbol-name variable) + ;; 'font-lock-variable-name-face) overkill + (princ (symbol-name variable)) + (princ "' is ") (while (variable-alias variable) (let ((newvar (variable-alias variable))) (if aliases ＠＠ -1443,8 +1444,8 ＠＠ (princ (format " -- loaded from \"%s\"\n" file-name)))) (princ "\nValue: ") (if (not (boundp variable)) - (princ "void\n") - (prin1 (symbol-value variable)) + (Help-princ-face "void\n" 'font-lock-comment-face) + (Help-prin1-face (symbol-value variable) 'font-lock-comment-face) (terpri)) (terpri) (cond ((local-variable-p variable (current-buffer)) Index: lisp/info.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/info.el,v retrieving revision 1.15.2.24 diff -u -w -r1.15.2.24 info.el --- info.el 2001/01/23 10:07:35 1.15.2.24 +++ info.el 2001/02/24 00:35:04 ＠＠ -6,7 +6,7 ＠＠ ;; Author: Dave Gillespie <daveg(a)synaptics.com&gt; ;; Richard Stallman <rms(a)gnu.ai.mit.edu&gt; ;; Maintainer: Dave Gillespie <daveg(a)synaptics.com&gt; -;; Version: 1.07 of 7/22/93 +;; Version: diverged at version 1.07 of 7/22/93 ;; Keywords: docs, help ;; This file is part of XEmacs. ＠＠ -26,7 +26,8 ＠＠ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: Not synched with FSF. +;;; Synched up with: Not synched with FSF. Highly divergent, and with +;;; many new features added for XEmacs. ;; Commentary: ＠＠ -37,7 +38,8 ＠＠ ;; Also, Info tries adding ".info" to a file name if the name itself ;; is not found. ;; -;; See the change log below for further details. +;; See the partial change log below for further details, and look into +;; ChangeLog for the rest. ;; LCD Archive Entry: ＠＠ -1795,8 +1797,17 ＠＠ (Info-select-node) (or (and (equal onode Info-current-node) (equal ofile Info-current-file)) - (Info-history-add ofile onode opoint))))) + (Info-history-add ofile onode opoint)))) + (message "Found \"%s\" in %s. Press `z' to continue search." + regexp Info-current-node) + )  +(defun Info-search-next () + "Repeat search starting from point with last regexp used in `Info-search'." + (interactive) + (Info-search Info-last-search)) + + ;; Extract the value of the node-pointer named NAME. ;; If there is none, use ERRORNAME in the error message; ;; if ERRORNAME is nil, just return nil. ＠＠ -2256,16 +2267,8 ＠＠ (setq this-command 'Info)) (scroll-down arg)))  -(defun Info-index (topic) - "Look up a string in the index for this file. -The index is defined as the first node in the top-level menu whose -name contains the word \"Index\", plus any immediately following -nodes whose names also contain the word \"Index\". -If there are no exact matches to the specified topic, this chooses -the first match which is a case-insensitive substring of a topic. -Use the `,' command to see the other matches. -Give a blank topic name to go to the Index node itself." - (interactive "sIndex topic: ") + +(defun Info-find-index-alternatives (topic) (let ((pattern (format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ \t]*%s" (regexp-quote topic) "\\(.*\\)\\.[ t]*\\([0-9]*\\)$")) ＠＠ -2283,9 +2286,7 ＠＠ (Info-goto-node (Info-extract-menu-node-name))) (or (equal topic "") (let ((matches nil) - (exact nil) - (Info-keeping-history nil) - found) + (Info-keeping-history nil)) (while (progn (goto-char (point-min)) ＠＠ -2305,17 +2306,41 ＠＠ (string-match "\\<Index\\>" node))) (let ((Info-fontify nil)) (Info-goto-node node))) + (nreverse matches))))) + +(defun Info-index (topic &optional starting-nodes) + "Look up a string in the index for this file. +The index is defined as the first node in the top-level menu whose +name contains the word \"Index\", plus any immediately following +nodes whose names also contain the word \"Index\". +If there are no exact matches to the specified topic, this chooses +the first match which is a case-insensitive substring of a topic. +Use the `,' command to see the other matches. +Give a blank topic name to go to the Index node itself. + +If STARTING-NODES is given, it should be a list of nodes specifying +files in which the indices will be searched. The results will be +combined together." + (interactive "sIndex topic: ") + (let ((matches (if starting-nodes + (mapcan #'(lambda (node) + (Info-goto-node node) + (Info-find-index-alternatives topic)) + starting-nodes) + (Info-find-index-alternatives topic))) + exact found) (or matches (progn - (Info-last) + (if (or (not starting-nodes) (< (length starting-nodes) 2)) + (Info-last)) (error "No \"%s\" in index" topic))) ;; Here it is a feature that assoc is case-sensitive. (while (setq found (assoc topic matches)) (setq exact (cons found exact) matches (delq found matches))) - (setq Info-index-alternatives (nconc exact (nreverse matches)) + (setq Info-index-alternatives (nconc exact matches) Info-index-first-alternative (car Info-index-alternatives)) - (Info-index-next 0))))) + (Info-index-next 0))) (defun Info-index-next (num) "Go to the next matching index item from the last `i' command." ＠＠ -2442,6 +2467,43 ＠＠ (Info-index (symbol-name func))) (pop-to-buffer "*info*"))  +(defun Info-read-search-text-regexp () + (read-from-minibuffer + (if (and (boundp 'Info-last-search) Info-last-search) + (format "Search (regexp, default %s): " + Info-last-search) + "Search (regexp): ") + nil nil nil nil nil (and (boundp 'Info-last-search) Info-last-search))) + +;;;###autoload +(defun Info-search-text-in-lispref (regexp) + "Search for REGEXP in Lispref text and select node it's found in." + (interactive (list (Info-read-search-text-regexp))) + (Info-goto-node "(Lispref)") + (Info-search regexp)) + +;;;###autoload +(defun Info-search-text-in-xemacs (regexp) + "Search for REGEXP in User's Manual text and select node it's found in." + (interactive (list (Info-read-search-text-regexp))) + (Info-goto-node "(XEmacs)") + (Info-search regexp)) + +;;;###autoload +(defun Info-search-index-in-lispref (regexp) + "Search for REGEXP in Lispref index and select node it's found in." + (interactive "sIndex topic: ") + (Info-goto-node "(Lispref)") + (Info-index regexp)) + +;;;###autoload +(defun Info-search-index-in-xemacs-and-lispref (regexp) + "Search for REGEXP in both User's Manual and Lispref indices. +Select node it's found in." + (interactive "sIndex topic: ") + (Info-index regexp '("(XEmacs)" "(Lispref)"))) + + (defun Info-reannotate-node () (let ((bufs (delq nil (mapcar 'get-file-buffer Info-annotations-path)))) (if bufs ＠＠ -2852,6 +2914,7 ＠＠ (define-key Info-mode-map "u" 'Info-up) (define-key Info-mode-map "v" 'Info-visit-file) (define-key Info-mode-map "x" 'Info-bookmark) + (define-key Info-mode-map "z" 'Info-search-next) (define-key Info-mode-map "<" 'Info-top) (define-key Info-mode-map ">" 'Info-end) (define-key Info-mode-map "[" 'Info-global-prev) Index: lisp/isearch-mode.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/isearch-mode.el,v retrieving revision 1.4.2.19 diff -u -w -r1.4.2.19 isearch-mode.el --- isearch-mode.el 2000/11/06 05:44:11 1.4.2.19 +++ isearch-mode.el 2001/02/24 00:35:04 ＠＠ -969,8 +969,9 ＠＠ (interactive) (if (and delete-key-deletes-forward (case (device-type) - ('tty (eq tty-erase-char ?\C-h)) - ('x (not (x-keysym-on-keyboard-sans-modifiers-p 'backspace))))) + ('tty (eq (declare-boundp tty-erase-char) ?\C-h)) + ('x (not (declare-fboundp + (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))))) (isearch-delete-char) (isearch-mode-help))) Index: lisp/keymap.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/keymap.el,v retrieving revision 1.6.2.2 diff -u -w -r1.6.2.2 keymap.el --- keymap.el 2000/11/06 05:44:08 1.6.2.2 +++ keymap.el 2001/02/24 00:35:05 ＠＠ -381,21 +381,25 ＠＠ ((stringp keys) (vconcat keys)) (t - (vector keys)))) - (event-to-list - #'(lambda (ev) - (append (event-modifiers ev) (list (event-key ev)))))) + (vector keys))))) + (flet ((event-to-list (ev) + (append (event-modifiers ev) (list (event-key ev))))) (mapvector #'(lambda (key) + (let* ((full-key (cond ((key-press-event-p key) - (funcall event-to-list key)) + (event-to-list key)) ((characterp key) - (funcall event-to-list (character-to-event key))) + (event-to-list (character-to-event key))) ((listp key) - key) + (copy-sequence key)) (t (list key)))) - vec))) + (keysym (car (last full-key)))) + (if (characterp keysym) + (setcar (last full-key) (intern (char-to-string keysym)))) + full-key)) + vec))))  ;;; Support keyboard commands to turn on various modifiers. Index: lisp/ldap.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/ldap.el,v retrieving revision 1.7.2.9 diff -u -w -r1.7.2.9 ldap.el --- ldap.el 2000/11/06 05:44:12 1.7.2.9 +++ ldap.el 2001/02/24 00:35:05 ＠＠ -35,6 +35,9 ＠＠ ;;; Code: +(globally-declare-fboundp '(ldapp ldap-open ldap-close ldap-add ldap-modify + ldap-delete)) + (eval-when '(load) (if (not (fboundp 'ldap-open)) (error "No LDAP support compiled in this XEmacs"))) Index: lisp/lib-complete.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/lib-complete.el,v retrieving revision 1.3.2.7 diff -u -w -r1.3.2.7 lib-complete.el --- lib-complete.el 2000/11/06 05:44:08 1.3.2.7 +++ lib-complete.el 2001/02/24 00:35:05 ＠＠ -221,6 +221,7 ＠＠ (defun read-library-internal (FILE FILTER FLAG) "Don't call this." ;; Relies on read-library-internal-search-path being let-bound + (declare (special read-library-internal-search-path)) (let ((completion-table (lib-complete:get-completion-table FILE read-library-internal-search-path FILTER))) ＠＠ -248,6 +249,7 ＠＠ filter the completions. This function is passed the filename, and should return a transformed filename (possibly a null transformation) or nil, indicating that the filename should not be included in the completions." + (declare (special read-library-internal-search-path)) (let* ((read-library-internal-search-path SEARCH-PATH) (library (completing-read PROMPT 'read-library-internal FILTER (or MUST-MATCH FULL) nil))) ＠＠ -258,8 +260,10 ＠＠ (t library)))) (defun read-library-name (prompt) - "PROMPTs for and returns an existing Elisp library name (without any suffix) or the empty string." + "PROMPTs for and returns an existing Elisp library name (without any suffix) +or the empty string." (interactive) + (declare (special read-library-internal-search-path)) (let ((read-library-internal-search-path load-path)) (completing-read prompt 'read-library-internal Index: lisp/lisp-mnt.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/lisp-mnt.el,v retrieving revision 1.3.2.4 diff -u -w -r1.3.2.4 lisp-mnt.el --- lisp-mnt.el 2000/12/27 06:47:10 1.3.2.4 +++ lisp-mnt.el 2001/02/24 00:35:05 ＠＠ -561,7 +561,7 ＠＠ (if addr (concat (car addr) " <" (cdr addr) ">") (or (and (boundp 'report-emacs-bug-beta-address) - report-emacs-bug-beta-address) + (declare-boundp report-emacs-bug-beta-address)) &quot;&lt;xemacs-beta(a)xemacs.org&gt;&quot;)) topic) (goto-char (point-max)) Index: lisp/menubar-items.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/menubar-items.el,v retrieving revision 1.6.2.36 diff -u -w -r1.6.2.36 menubar-items.el --- menubar-items.el 2001/01/17 08:35:10 1.6.2.36 +++ menubar-items.el 2001/02/24 00:35:06 ＠＠ -332,14 +332,7 ＠＠ ["%_Save Abbrevs As..." write-abbrev-file] ["L%_oad Abbrevs..." read-abbrev-file] ) - ("%_Register" - ["%_Copy to Register..." copy-to-register :active (region-exists-p)] - ["%_Paste Register..." insert-register] - "---" - ["%_Save Point to Register" point-to-register] - ["%_Jump to Register" register-to-point] - ) - ("R%_ectangles" + ("%_Rectangles" ["%_Kill Rectangle" kill-rectangle] ["%_Yank Rectangle" yank-rectangle] ["Rectangle %_to Register" copy-rectangle-to-register] ＠＠ -352,6 +345,13 ＠＠ (not mouse-track-rectangle-p)) :style toggle :selected mouse-track-rectangle-p] ) + ("Re%_gister" + ["%_Copy to Register..." copy-to-register :active (region-exists-p)] + ["%_Paste Register..." insert-register] + "---" + ["%_Save Point to Register" point-to-register] + ["%_Jump to Register" register-to-point] + ) ("%_Sort" ["%_Lines in Region" sort-lines :active (region-exists-p)] ["%_Paragraphs in Region" sort-paragraphs :active (region-exists-p)] ＠＠ -1395,7 +1395,11 ＠＠ ["Edit I%_nit File" ;; #### there should be something that holds the name that the init ;; file should be created as, when it's not present. - (progn (find-file (or user-init-file "~/.xemacs/init.el")) + (let ((el-file (or user-init-file "~/.xemacs/init.el"))) + (if (string-match "\\.elc$" el-file) + (setq el-file + (substring user-init-file 0 (1- (length el-file))))) + (find-file el-file) (or (eq major-mode 'emacs-lisp-mode) (emacs-lisp-mode)))] ["%_Save Options to Init File" customize-save-customized] ＠＠ -1416,49 +1420,61 ＠＠ ("%_Help" ["%_About XEmacs..." about-xemacs] + ["%_Home Page (www.xemacs.org)" xemacs-www-page + :active (fboundp 'browse-url)] "-----" ["XEmacs %_News" view-emacs-news] ["%_Obtaining XEmacs" describe-distribution] "-----" ("%_Info (Online Docs)" - ["%_Info Contents" info] - ["Lookup %_Key Binding..." Info-goto-emacs-key-command-node] - ["Lookup %_Command..." Info-goto-emacs-command-node] - ["Lookup %_Function..." Info-elisp-ref] - ["Lookup %_Topic..." Info-query]) + ["Info Con%_tents" (Info-goto-node "(dir)")] + "-----" + ["XEmacs %_User's Manual" (Info-goto-node "(XEmacs)")] + ["XEmacs %_Lisp Reference Manual" (Info-goto-node "(Lispref)")] + ["All About %_Packages" (Info-goto-node "(xemacs)Packages")] + ["%_Getting Started with XEmacs" (Info-goto-node "(New-Users-Guide)")] + ["XEmacs In%_ternals Manual" (Info-goto-node "(Internals)")] + ["%_How to Use Info" (Info-goto-node "(Info)")] + "-----" + ["Lookup %_Key Sequence in User's Manual..." + Info-goto-emacs-key-command-node] + ["Lookup %_Command in User's Manual..." Info-goto-emacs-command-node] + ["Lookup %_Function in Lisp Reference..." Info-elisp-ref] + "-----" + ["Search %_Index in User's Manual/Lispref..." + Info-search-index-in-xemacs-and-lispref] + ["%_Search Text in User's Manual..." Info-search-text-in-xemacs] + ["S%_earch Text in Lisp Reference..." + Info-search-text-in-lispref] + ) ("XEmacs %_FAQ" ["%_FAQ (local)" xemacs-local-faq] ["FAQ via %_WWW" xemacs-www-faq - :active (fboundp 'browse-url)] - ["%_Home Page" xemacs-www-page :active (fboundp 'browse-url)]) ("%_Tutorials" :filter tutorials-menu-filter) ("%_Samples" - ["Sample .%_emacs" - (find-file (locate-data-file "sample.emacs")) - :active (locate-data-file "sample.emacs")] - ["Sample .%_Xdefaults" + ["View Sample %_init.el" view-sample-init-el + :active (locate-data-file "sample.init.el")] + ["View Sample .%_Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) :active (locate-data-file "sample.Xdefaults")] - ["Sample e%_nriched" + ["View Sample e%_nriched.doc" (find-file (locate-data-file "enriched.doc")) :active (locate-data-file "enriched.doc")]) - ("%_Commands & Keys" - ["%_Mode" describe-mode] + ("%_Commands, Variables, Keys" + ["Describe %_Mode" describe-mode] ["%_Apropos..." hyper-apropos] ["Apropos %_Docs..." apropos-documentation] "-----" - ["%_Key..." describe-key] - ["%_Bindings" describe-bindings] - ["%_Mouse Bindings" describe-pointer] + ["Describe %_Key..." describe-key] + ["Show %_Bindings" describe-bindings] + ["Show M%_ouse Bindings" describe-pointer] ["%_Recent Keys" view-lossage] "-----" - ["%_Function..." describe-function] - ["%_Variable..." describe-variable] - ["%_Locate Command..." where-is]) - "-----" - ["%_Recent Messages" view-lossage] + ["Describe %_Function..." describe-function] + ["Describe %_Variable..." describe-variable] + ["%_Locate Command in Keymap..." where-is]) ("%_Misc" ["%_Current Installation Info" describe-installation :active (boundp 'Installation-string)] ＠＠ -1467,6 +1483,8 ＠＠ ["Find %_Packages" finder-by-keyword] ["View %_Splash Screen" xemacs-splash-buffer] ["%_Unix Manual..." manual-entry]) + "-----" + ["%_Recent Messages" view-lossage] ["Send %_Bug Report..." report-emacs-bug :active (fboundp 'report-emacs-bug)]))) ＠＠ -1911,24 +1929,12 ＠＠ (defconst default-popup-menu '("XEmacs Commands" - ["%_Undo" advertised-undo - :active (and (not (eq buffer-undo-list t)) - (or buffer-undo-list pending-undo-list)) - :suffix (if (or (eq last-command 'undo) - (eq last-command 'advertised-undo)) - "More" "")] - ["Cu%_t" kill-primary-selection - :active (selection-owner-p)] - ["%_Copy" copy-primary-selection - :active (selection-owner-p)] - ["%_Paste" yank-clipboard-selection - :active (selection-exists-p 'CLIPBOARD)] - ["%_Delete" delete-primary-selection - :active (selection-owner-p)] - "-----" - ["Select %_Block" mark-paragraph] - ["Sp%_lit Window" split-window-vertically] - ["U%_nsplit Window" delete-other-windows] + ["%_Split Window" split-window-vertically] + ["S%_plit Window (Side by Side)" split-window-horizontally] + ["%_Un-Split (Keep This)" delete-other-windows + :active (not (one-window-p t))] + ["Un-Split (Keep %_Others)" delete-window + :active (not (one-window-p t))] )) ;; In an effort to avoid massive menu clutter, this mostly worthless menu is ＠＠ -1939,22 +1945,17 ＠＠ ;; misc (defun xemacs-splash-buffer () - "Redisplay XEmacs splash screen in a buffer." + "Display XEmacs splash screen in a buffer." (interactive) (let ((buffer (get-buffer-create "*Splash*")) tmout) (set-buffer buffer) - (setq buffer-read-only t) + (setq buffer-read-only nil) (erase-buffer buffer) - (setq tmout (display-splash-frame)) + (setq tmout (display-splash-screen)) (when tmout - (make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook - `(lambda () - (disable-timeout ,tmout)) - nil t)) - (pop-to-buffer buffer) - (delete-other-windows))) + (add-local-hook 'kill-buffer-hook + `(lambda () (disable-timeout ,tmout))))))  ;;; backwards compatibility Index: lisp/menubar.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/menubar.el,v retrieving revision 1.6.2.8 diff -u -w -r1.6.2.8 menubar.el --- menubar.el 2000/11/18 02:20:17 1.6.2.8 +++ menubar.el 2001/02/24 00:35:06 ＠＠ -523,35 +523,40 ＠＠ (extent-property extent 'context-menu)) context-extents)))) (popup-menu - (cond ((and global-popup-menu mode-popup-menu) + (progn ;; Merge global-popup-menu and mode-popup-menu - (check-menu-syntax mode-popup-menu) - (let* ((title (car mode-popup-menu)) - (items (cdr mode-popup-menu)) + (and mode-popup-menu (check-menu-syntax mode-popup-menu)) + (let* ((mode-title (and (stringp (car mode-popup-menu)) + (car mode-popup-menu))) + (mode-items (if mode-title (cdr mode-popup-menu) + mode-popup-menu)) + (global-title (and (stringp (car global-popup-menu)) + (car global-popup-menu))) + (global-items (if global-title (cdr global-popup-menu) + global-popup-menu)) mode-filters) ;; Strip keywords from local menu for attaching them at the top - (while (and items - (keywordp (car items))) + (while (and mode-items + (keywordp (car mode-items))) ;; Push both keyword and its argument. - (push (pop items) mode-filters) - (push (pop items) mode-filters)) + (push (pop mode-items) mode-filters) + (push (pop mode-items) mode-filters)) (setq mode-filters (nreverse mode-filters)) ;; If mode-filters contains a keyword already present in ;; `global-popup-menu', you will probably lose. - (append (list (car global-popup-menu)) + (append (and popup-menu-titles + (cond (mode-title (list mode-title)) + (global-title (list global-title)) + (t ""))) mode-filters - (cdr global-popup-menu) - '("---" "---") - (if popup-menu-titles (list title)) - (if popup-menu-titles '("---" "---")) - items - context-menu-items))) - (t - (append - (or mode-popup-menu - global-popup-menu - (error "No menu defined in this buffer")) - context-menu-items)))) + context-menu-items + (and context-menu-items mode-items '("---")) + mode-items + (and (or context-menu-items mode-items) + global-items '("---" "---")) + (and global-title (list global-title)) + global-items + )))) (while (popup-up-p) (dispatch-event (next-event))) ＠＠ -559,7 +564,7 ＠＠ )) (defun popup-buffer-menu (event) - "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked." + "Pop up a copy of the menubar Buffers menu where the mouse is clicked." (interactive "e") (let ((window (and (event-over-text-area-p event) (event-window event))) (bmenu nil)) ＠＠ -712,11 +717,11 ＠＠ (define-key menu-accelerator-map [up] 'menu-up) (define-key menu-accelerator-map [down] 'menu-down) (define-key menu-accelerator-map [return] 'menu-select) - (define-key menu-accelerator-map [kp_down] 'menu-down) - (define-key menu-accelerator-map [kp_up] 'menu-down) - (define-key menu-accelerator-map [kp_left] 'menu-left) - (define-key menu-accelerator-map [kp_right] 'menu-right) - (define-key menu-accelerator-map [kp_enter] 'menu-select) + (define-key menu-accelerator-map [kp-down] 'menu-down) + (define-key menu-accelerator-map [kp-up] 'menu-down) + (define-key menu-accelerator-map [kp-left] 'menu-left) + (define-key menu-accelerator-map [kp-right] 'menu-right) + (define-key menu-accelerator-map [kp-enter] 'menu-select) (define-key menu-accelerator-map "\C-g" 'menu-quit)))  Index: lisp/minibuf.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/minibuf.el,v retrieving revision 1.14.2.24 diff -u -w -r1.14.2.24 minibuf.el --- minibuf.el 2000/11/06 05:44:11 1.14.2.24 +++ minibuf.el 2001/02/24 00:35:08 ＠＠ -1099,9 +1099,11 ＠＠ (if (and filename-kludge-p ;; #### evil evil evil evil (or (and (fboundp 'ange-ftp-ftp-path) - (ange-ftp-ftp-path string)) + (declare-fboundp + (ange-ftp-ftp-path string))) (and (fboundp 'efs-ftp-path) - (efs-ftp-path string)))) + (declare-fboundp + (efs-ftp-path string))))) (setq comp t) (setq comp (try-completion string ＠＠ -1126,8 +1128,9 ＠＠ (set-buffer mouse-grabbed-buffer) ; the minibuf (let ((kludge-string (concat (buffer-string) string))) (if (or (and (fboundp 'ange-ftp-ftp-path) - (ange-ftp-ftp-path kludge-string)) - (and (fboundp 'efs-ftp-path) (efs-ftp-path kludge-string))) + (declare-fboundp (ange-ftp-ftp-path kludge-string))) + (and (fboundp 'efs-ftp-path) + (declare-fboundp (efs-ftp-path kludge-string)))) ;; #### evil evil evil, but more so. string (append-expand-filename (buffer-string) string))))) ＠＠ -1787,10 +1790,12 ＠＠ ((eq action 't) ;; all completions (mapcar #'(lambda (p) (concat "~" p)) - (user-name-all-completions user))) + (declare-fboundp + (user-name-all-completions user)))) (t;; 'nil ;; complete - (let* ((val+uniq (user-name-completion-1 user)) + (let* ((val+uniq (declare-fboundp + (user-name-completion-1 user))) (val (car val+uniq)) (uniq (cdr val+uniq))) (cond ((stringp val) ＠＠ -2239,9 +2244,9 ＠＠ (setq x-read-color-completion-table clist) x-read-color-completion-table))) (mswindows - (mapcar #'list (mswindows-color-list))) + (mapcar #'list (declare-fboundp (mswindows-color-list)))) (tty - (mapcar #'list (tty-color-list))))) + (mapcar #'list (declare-fboundp (tty-color-list)))))) (defun read-color (prompt &optional must-match initial-contents) "Read the name of a color from the minibuffer. Index: lisp/modeline.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/modeline.el,v retrieving revision 1.18.2.10 diff -u -w -r1.18.2.10 modeline.el --- modeline.el 2000/10/12 07:22:41 1.18.2.10 +++ modeline.el 2001/02/24 00:35:08 ＠＠ -672,7 +672,7 ＠＠ modeline is clicked. It will call `vc-toggle-read-only' if available, otherwise it will call the usual `toggle-read-only'." (interactive) - (if (fboundp 'vc-toggle-read-only) + (if-fboundp 'vc-toggle-read-only (vc-toggle-read-only) (toggle-read-only))) Index: lisp/mouse.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/mouse.el,v retrieving revision 1.19.2.12 diff -u -w -r1.19.2.12 mouse.el --- mouse.el 2000/12/04 12:25:21 1.19.2.12 +++ mouse.el 2001/02/24 00:35:09 ＠＠ -90,7 +90,7 ＠＠ (interactive) (if (and (not (console-on-window-system-p)) (and (featurep 'gpm) - (not gpm-minor-mode))) + (not (declare-boundp gpm-minor-mode)))) (yank) (push-mark) (if (region-active-p) ＠＠ -1058,7 +1058,7 ＠＠ (not (= start end))) ;; I guess cutbuffers should do something with rectangles too. ;; does anybody use them? - (x-store-cutbuffer (buffer-substring start end))))) + (declare-fboundp (x-store-cutbuffer (buffer-substring start end)))))) (defun default-mouse-track-deal-with-down-event (click-count) (let ((event default-mouse-track-down-event)) Index: lisp/msw-font-menu.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/Attic/msw-font-menu.el,v retrieving revision 1.1.2.2 diff -u -w -r1.1.2.2 msw-font-menu.el --- msw-font-menu.el 2000/10/12 07:22:41 1.1.2.2 +++ msw-font-menu.el 2001/02/24 00:35:09 ＠＠ -64,9 +64,11 ＠＠ or if you change your font path, you can call this to re-initialize the menus." (unless mswindows-font-regexp-ascii (setq mswindows-font-regexp-ascii (if (featurep 'mule) - (charset-registry 'ascii) + (declare-fboundp + (charset-registry 'ascii)) "Western"))) - (setq mswindows-font-menu-registry-encoding (if (featurep 'mule) "" "Western")) + (setq mswindows-font-menu-registry-encoding (if (featurep 'mule) "" + "Western")) (let ((case-fold-search t) family size weight entry dev-cache cache families sizes weights) Index: lisp/multicast.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/multicast.el,v retrieving revision 1.1.2.2 diff -u -w -r1.1.2.2 multicast.el --- multicast.el 2000/11/06 05:44:08 1.1.2.2 +++ multicast.el 2001/02/24 00:35:09 ＠＠ -75,7 +75,7 ＠＠ (error "invalid port specification.")) (and (= 0 (setq ttl (string-to-int (match-string 3 address)))) (error "invalid ttl specification.")) - (open-multicast-group-internal name buffer dest port ttl) + (declare-fboundp (open-multicast-group-internal name buffer dest port ttl)) )) ;;; multicast.el ends here Index: lisp/package-get.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/package-get.el,v retrieving revision 1.13.2.33 diff -u -w -r1.13.2.33 package-get.el --- package-get.el 2001/01/17 21:54:29 1.13.2.33 +++ package-get.el 2001/02/24 00:35:10 ＠＠ -445,7 +445,7 ＠＠ (fboundp 'mc-pgp-verify-region) (or (not (condition-case err - (mc-pgp-verify-region beg end) + (declare-fboundp (mc-pgp-verify-region beg end)) (file-error (and (string-match "No such file" (nth 2 err)) (or (not package-get-require-signed-base-updates) Index: lisp/simple.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/simple.el,v retrieving revision 1.24.2.26 diff -u -w -r1.24.2.26 simple.el --- simple.el 2000/12/08 11:00:17 1.24.2.26 +++ simple.el 2001/02/24 00:35:11 ＠＠ -58,10 +58,10 ＠＠ ;; this isn't a user-visible change. These functions have also been altered ;; to use (mark t) for the same reason. -;; 97/3/14 Jareth Hein (jhod(a)po.iijnet.or.jp) added kinsoku processing (support -;; for filling of Asian text) into the fill code. This was ripped bleeding from -;; Mule-2.3, and could probably use some feature additions (like additional wrap -;; styles, etc) +;; 97/3/14 Jareth Hein (jhod(a)po.iijnet.or.jp) added kinsoku processing +;; (support for filling of Asian text) into the fill code. This was +;; ripped bleeding from Mule-2.3, and could probably use some feature +;; additions (like additional wrap styles, etc) ;; 97/06/11 Steve Baur (steve(a)xemacs.org) Convert use of ;; (preceding|following)-char to char-(after|before). ＠＠ -453,7 +453,8 ＠＠ (defsubst delete-forward-p () (and delete-key-deletes-forward (or (not (eq (device-type) 'x)) - (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))) + (declare-fboundp + (x-keysym-on-keyboard-sans-modifiers-p 'backspace))))) (defun backward-or-forward-delete-char (arg) "Delete either one character backwards or one character forwards. ＠＠ -2649,6 +2650,15 ＠＠ (if arg (forward-line 1)) (setq count (1- count))))) +;; This variable: Synched up with 20.7. +(defvar comment-padding 1 + "Number of spaces `comment-region' puts between comment chars and text. + +Extra spacing between the comment characters and the comment text +makes the comment easier to read. Default is 1. Nil means 0 and is +more efficient.") + +;; This function: Synched up with 20.7. (defun comment-region (start end &optional arg) "Comment or uncomment each line in the region. With just C-u prefix arg, uncomment each line in region. ＠＠ -2666,6 +2676,8 ＠＠ (save-excursion (save-restriction (let ((cs comment-start) (ce comment-end) + (cp (when comment-padding + (make-string comment-padding ? ))) numarg) (if (consp arg) (setq numarg t) (setq numarg (prefix-numeric-value arg)) ＠＠ -2678,17 +2690,40 ＠＠ ;; Loop over all lines from START to END. (narrow-to-region start end) (goto-char start) + ;; if user didn't specify how many comments to remove, be smart + ;; and remove the minimal number that all lines have. that way, + ;; comments in a region of Elisp code that gets commented out will + ;; get put back correctly. + (if (eq numarg t) + (let ((min-comments 999999)) (while (not (eobp)) + (let ((this-comments 0)) + (while (looking-at (regexp-quote cs)) + (incf this-comments) + (forward-char (length cs))) + (if (and (> this-comments 0) (< this-comments min-comments)) + (setq min-comments this-comments)) + (forward-line 1))) + (if (< min-comments 999999) + (setq numarg (- min-comments))) + (goto-char start))) (if (or (eq numarg t) (< numarg 0)) - (progn + (while (not (eobp)) + (let (found-comment) ;; Delete comment start from beginning of line. (if (eq numarg t) (while (looking-at (regexp-quote cs)) + (setq found-comment t) (delete-char (length cs))) (let ((count numarg)) (while (and (> 1 (setq count (1+ count))) (looking-at (regexp-quote cs))) + (setq found-comment t) (delete-char (length cs))))) + ;; Delete comment padding from beginning of line + (when (and found-comment comment-padding + (looking-at (regexp-quote cp))) + (delete-char comment-padding)) ;; Delete comment end from end of line. (if (string= "" ce) nil ＠＠ -2698,11 +2733,12 ＠＠ ;; This is questionable if comment-end ends in ;; whitespace. That is pretty brain-damaged, ;; though. - (skip-chars-backward " \t") - (if (and (>= (- (point) (point-min)) (length ce)) + (while (progn (skip-chars-backward " \t") + (and (>= (- (point) (point-min)) + (length ce)) (save-excursion (backward-char (length ce)) - (looking-at (regexp-quote ce)))) + (looking-at (regexp-quote ce))))) (delete-char (- (length ce))))) (let ((count numarg)) (while (> 1 (setq count (1+ count))) ＠＠ -2710,11 +2746,16 ＠＠ ;; This is questionable if comment-end ends in ;; whitespace. That is pretty brain-damaged though (skip-chars-backward " \t") + (if (>= (- (point) (point-min)) (length ce)) (save-excursion (backward-char (length ce)) (if (looking-at (regexp-quote ce)) - (delete-char (length ce)))))))) - (forward-line 1)) + (delete-char (length ce))))))))) + (forward-line 1))) + + (when comment-padding + (setq cs (concat cs cp))) + (while (not (eobp)) ;; Insert at beginning and at end. (if (looking-at "[ \t]*$") () (insert cs) ＠＠ -2842,12 +2883,11 ＠＠ (fill-point (let ((opoint (point)) bounce - ;; 97/3/14 jhod: Kinsoku - (re-break-point (if (featurep 'mule) + (re-break-point ;; Kinsoku processing + (if (featurep 'mule) (concat "[ \t\n]\\|" word-across-newline ".\\|." word-across-newline) "[ \t\n]")) - ;; end patch (first t)) (save-excursion (move-to-column (1+ fill-column)) ＠＠ -2864,24 +2904,21 ＠＠ (and (looking-at "\\. ") (not (looking-at "\\. ")))))) (setq first nil) - ;; 97/3/14 jhod: Kinsoku - ; (skip-chars-backward "^ \t\n")) + ;; XEmacs: change for Kinsoku processing (fill-move-backward-to-break-point re-break-point) - ;; end patch ;; If we find nowhere on the line to break it, ;; break after one word. Set bounce to t ;; so we will not keep going in this while loop. (if (bolp) (progn - ;; 97/3/14 jhod: Kinsoku - ; (re-search-forward "[ \t]" opoint t) + ;; XEmacs: change for Kinsoku processing (fill-move-forward-to-break-point re-break-point opoint) - ;; end patch (setq bounce t))) (skip-chars-backward " \t")) (if (and (featurep 'mule) - (or bounce (bolp))) (kinsoku-process)) ;; 97/3/14 jhod: Kinsoku + (or bounce (bolp))) + (declare-fboundp (kinsoku-process))) ;; Let fill-point be set to the place where we end up. (point))))) ＠＠ -2900,7 +2937,8 ＠＠ ;; break the line there. (if (save-excursion (goto-char fill-point) - (not (or (bolp) (eolp)))) ; 97/3/14 jhod: during kinsoku processing it is possible to move beyond + ;; during kinsoku processing it is possible to move beyond + (not (or (bolp) (eolp)))) (let ((prev-column (current-column))) ;; If point is at the fill-point, do not `save-excursion'. ;; Otherwise, if a comment prefix or fill-prefix is inserted, ＠＠ -2911,7 +2949,7 ＠＠ ;; 1999-09-17 hniksic: turn off Kinsoku until ;; it's debugged. (funcall comment-line-break-function) - ;; 97/3/14 jhod: Kinsoku processing + ;; XEmacs: Kinsoku processing ; ;(indent-new-comment-line) ; (let ((spacep (memq (char-before (point)) '(?\ ?\t)))) ; (funcall comment-line-break-function) ＠＠ -3101,9 +3139,8 ＠＠ (interactive) (let (comcol comstart) (skip-chars-backward " \t") - ;; 97/3/14 jhod: Kinsoku processing (if (featurep 'mule) - (kinsoku-process)) + (declare-fboundp (kinsoku-process))) (delete-region (point) (progn (skip-chars-forward " \t") (point))) Index: lisp/sound.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/sound.el,v retrieving revision 1.5.2.5 diff -u -w -r1.5.2.5 sound.el --- sound.el 2001/01/29 14:10:47 1.5.2.5 +++ sound.el 2001/02/24 00:35:12 ＠＠ -140,10 +140,11 ＠＠ You can only play sound files if you are running on display 0 of the console of a machine with native sound support or running a NetAudio -server and XEmacs has the necessary sound support compiled in. +or ESD server and XEmacs has the necessary sound support compiled in. -The sound file must be in the Sun/NeXT U-LAW format, except on Linux, -where .wav files are also supported by the sound card drivers." +The sound file must be in the Sun/NeXT U-LAW format, except on Linux +and MS Windows, where .wav files are also supported by the sound card +drivers." (interactive "fSound file name: \n\ SSymbol to name this sound: \n\ nVolume (0 for default): ") ＠＠ -151,17 +152,14 ＠＠ (error "sound-name not a symbol")) (unless (or (null volume) (integerp volume)) (error "volume not an integer or nil")) - (let ((file (if (file-name-absolute-p filename) + (let ((file ;; For absolute file names, we don't have on choice on the ;; location, but sound extensions however can still be tried - (setq file (locate-file filename + (locate-file filename + (if (file-name-absolute-p filename) (list (file-name-directory filename)) - (split-string sound-extension-list - ":"))) - (setq file (locate-file filename - default-sound-directory-list - (split-string sound-extension-list - ":"))))) + default-sound-directory-list) + (split-string sound-extension-list ":"))) buf data) (unless file (error "Couldn't load sound file %s" filename)) Index: lisp/syntax.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/syntax.el,v retrieving revision 1.2.2.2 diff -u -w -r1.2.2.2 syntax.el --- syntax.el 2000/11/06 05:44:08 1.2.2.2 +++ syntax.el 2001/02/24 00:35:12 ＠＠ -248,8 +248,8 ＠＠ (if (equal first last) (cond ((vectorp first) (princ (format "%s, row %d\t" - (charset-name - (aref first 0)) + (declare-fboundp (charset-name + (aref first 0))) (aref first 1)) stream)) ((symbolp first) ＠＠ -260,8 +260,8 ＠＠ (princ "\t" stream))) (cond ((vectorp first) (princ (format "%s, rows %d .. %d\t" - (charset-name - (aref first 0)) + (declare-fboundp (charset-name + (aref first 0))) (aref first 1) (aref last 1)) stream)) ＠＠ -303,8 +303,8 ＠＠ (and (characterp range) (characterp first-char) (or (not (featurep 'mule)) - (eq (char-charset range) - (char-charset first-char))) + (eq (declare-fboundp (char-charset range)) + (declare-fboundp (char-charset first-char)))) (= (char-int last-char) (1- (char-int range)))) (and (vectorp range) (vectorp first-char) Index: lisp/toolbar-items.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/toolbar-items.el,v retrieving revision 1.4.2.3 diff -u -w -r1.4.2.3 toolbar-items.el --- toolbar-items.el 2000/09/11 09:57:24 1.4.2.3 +++ toolbar-items.el 2001/02/24 00:35:12 ＠＠ -37,13 +37,6 ＠＠ ;;; Code: -;; Suppress warning message from bytecompiler -(eval-when-compile - (defvar pending-delete-mode) - ;; #### The compiler still warns about missing - ;; `pending-delete-pre-hook'. Any way to get rid of the warning? - ) - (defgroup toolbar nil "Configure XEmacs Toolbar functions and properties" :group 'environment) ＠＠ -132,9 +125,9 ＠＠ (interactive) ;; This horrible kludge is for pending-delete to work correctly. (and (boundp 'pending-delete-mode) - pending-delete-mode + (declare-boundp pending-delete-mode) (let ((this-command toolbar-paste-function)) - (pending-delete-pre-hook))) + (declare-fboundp (pending-delete-pre-hook)))) (call-interactively toolbar-paste-function)) (defcustom toolbar-undo-function 'undo ＠＠ -569,6 +562,7 ＠＠ "The initial toolbar for a buffer.") (defun x-init-toolbar-from-resources (locale) + (with-fboundp 'x-init-specifier-from-resources (x-init-specifier-from-resources top-toolbar-height 'natnum locale '("topToolBarHeight" . "TopToolBarHeight")) ＠＠ -592,6 +586,6 ＠＠ '("leftToolBarBorderWidth" . "LeftToolBarBorderWidth")) (x-init-specifier-from-resources right-toolbar-border-width 'natnum locale - '("rightToolBarBorderWidth" . "RightToolBarBorderWidth"))) + '("rightToolBarBorderWidth" . "RightToolBarBorderWidth")))) ;;; toolbar-items.el ends here Index: lisp/bytecomp.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/bytecomp.el,v retrieving revision 1.8.2.21 diff -u -w -r1.8.2.21 bytecomp.el --- bytecomp.el 2000/12/01 09:54:31 1.8.2.21 +++ bytecomp.el 2001/02/24 00:35:14 ＠＠ -421,6 +421,12 ＠＠ when an error occurs in a file. This is bound to t by `batch-byte-recompile-directory'.") +(defvar byte-recompile-ignore-uncompilable-mule-files t + "If non-nil, `byte-recompile-*' ignores non-ASCII .el files in a non-Mule +XEmacs. This assumes that such files have a -*- coding: ??? -*- magic +cookie in their first line or a ;;;###coding system: magic cookie +early in the file.") + (defvar byte-recompile-directory-recursively t "*If true, then `byte-recompile-directory' will recurse on subdirectories.") ＠＠ -943,11 +949,19 ＠＠ " at " (current-time-string) "\n") (setq byte-compile-current-file nil)))) +(defvar byte-compile-inbuffer) +(defvar byte-compile-outbuffer) + (defun byte-compile-warn (format &rest args) (setq format (apply 'format format args)) (if byte-compile-error-on-warn (error "%s" format) ; byte-compile-file catches and logs it - (byte-compile-log-1 (concat "** " format) t) + (byte-compile-log-1 (concat "** line: " + (save-excursion + (set-buffer byte-compile-inbuffer) + (int-to-string (line-number))) + " " + format) t) ;;; RMS says: ;;; It is useless to flash warnings too fast to be read. ;;; Besides, they will all be shown at the end. ＠＠ -1436,6 +1450,11 ＠＠ ;; It is an ordinary file. Decide whether to compile it. (if (and (string-match emacs-lisp-file-regexp source) (not (auto-save-file-name-p source)) + ;; make sure not a mule file we can't handle. + (or (not byte-recompile-ignore-uncompilable-mule-files) + (featurep 'mule) + (not (find-coding-system-magic-cookie-in-file + source))) (setq dest (byte-compile-dest-file source)) (if (file-exists-p dest) ;; File was already compiled. ＠＠ -1480,7 +1499,10 ＠＠ (file-newer-than-file-p filename dest) (and force (or (eq 0 force) - (y-or-n-p (concat "Compile " filename "? ")))))) + (y-or-n-p (concat "Compile " filename "? "))))) + (or (not byte-recompile-ignore-uncompilable-mule-files) + (featurep 'mule) + (not (find-coding-system-magic-cookie-in-file filename)))) (byte-compile-file filename)))) ;;;###autoload ＠＠ -1621,9 +1643,6 ＠＠ (prin1 value (current-buffer)) (insert "\n")) ((message "%s" (prin1-to-string value))))))) - -(defvar byte-compile-inbuffer) -(defvar byte-compile-outbuffer) (defun byte-compile-from-buffer (byte-compile-inbuffer filename &optional eval) ;; buffer --> output-buffer, or buffer --> eval form, return nil Index: lisp/font-lock.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/font-lock.el,v retrieving revision 1.7.2.29 diff -u -w -r1.7.2.29 font-lock.el --- font-lock.el 2001/02/19 06:24:27 1.7.2.29 +++ font-lock.el 2001/02/24 00:35:15 ＠＠ -1186,12 +1186,14 ＠＠ next redisplay cycle, avoiding excessive fontification when many buffer modifications are performed or a buffer is reverted.") -(defvar font-lock-pending-extent-table (make-hash-table :weakness 'key)) +;; list of buffers in which there is a pending change. +(defvar font-lock-pending-buffer-table (make-hash-table :weakness 'key)) +;; table used to keep track of ranges needing fontification. (defvar font-lock-range-table (make-range-table)) (defun font-lock-pre-idle-hook () (condition-case font-lock-error - (if (> (hash-table-count font-lock-pending-extent-table) 0) + (if (> (hash-table-count font-lock-pending-buffer-table) 0) (font-lock-fontify-pending-extents)) (error (warn "Error caught in `font-lock-pre-idle-hook': %s" font-lock-error)))) ＠＠ -1203,12 +1205,15 ＠＠ (defun font-lock-after-change-function (beg end old-len) (when font-lock-mode - (let ((ex (make-extent beg end))) - (set-extent-property ex 'detachable nil) - (set-extent-property ex 'end-open nil) - (let ((exs (gethash (current-buffer) font-lock-pending-extent-table))) - (push ex exs) - (puthash (current-buffer) exs font-lock-pending-extent-table))) + ;; treat deletions as if the following character (or previous, if + ;; there is no following) were inserted. this is a bit of a hack + ;; but allows us to use text properties for everything. + (if (= beg end) + (cond ((/= end (point-max)) (setq end (1+ end))) + ((/= beg (point-min)) (setq beg (1- beg))) + (t nil))) + (put-text-property beg end 'font-lock-pending t) + (puthash (current-buffer) t font-lock-pending-buffer-table) (if font-lock-always-fontify-immediately (font-lock-fontify-pending-extents)))) ＠＠ -1218,27 +1223,29 ＠＠ ;; only one buffer and one contiguous region! (save-match-data (maphash - #'(lambda (buffer exs) + #'(lambda (buffer dummy) ;; remove first, to avoid infinite reprocessing if error - (remhash buffer font-lock-pending-extent-table) + (remhash buffer font-lock-pending-buffer-table) (when (buffer-live-p buffer) (clear-range-table font-lock-range-table) (with-current-buffer buffer (save-excursion (save-restriction - ;; if we don't widen, then the C code will fail to - ;; realize that we're inside a comment. + ;; if we don't widen, then the C code in + ;; syntactically-sectionize will fail to realize that + ;; we're inside a comment. (widen) (let ((zmacs-region-stays zmacs-region-stays)) ; protect from change! - (mapc - #'(lambda (ex) - ;; paranoia. - (when (and (extent-live-p ex) - (not (extent-detached-p ex))) - ;; first expand the ranges to full lines, because - ;; that is what will be fontified; then use a - ;; range table to merge the ranges. + (map-extents + #'(lambda (ex dummy-maparg) + ;; first expand the ranges to full lines, + ;; because that is what will be fontified; + ;; then use a range table to merge the + ;; ranges. (we could also do this simply using + ;; text properties. the range table code was + ;; here from a previous version of this code + ;; and works just as well.) (let* ((beg (extent-start-position ex)) (end (extent-end-position ex)) (beg (progn (goto-char beg) ＠＠ -1247,10 +1254,12 ＠＠ (end (progn (goto-char end) (forward-line 1) (point)))) - (detach-extent ex) (put-range-table beg end t - font-lock-range-table)))) - exs) + font-lock-range-table))) + nil nil nil nil nil 'font-lock-pending t) + ;; clear all pending extents first in case of error below. + (put-text-property (point-min) (point-max) + 'font-lock-pending nil) (map-range-table #'(lambda (beg end val) ;; Maybe flush the internal cache used by ＠＠ -1272,10 +1281,122 ＠＠ ;; (font-lock-fontify-region beg end))) (font-lock-fontify-region beg end)) font-lock-range-table))))))) - font-lock-pending-extent-table))) + font-lock-pending-buffer-table)))  ;; Syntactic fontification functions. +;; Note: Here is the FSF version. (#### which FSF version?) Our +;; version is much faster because of the C support we provide. This +;; may be useful for reference, however, and perhaps there is +;; something useful here that should be merged into our version. +;; +;(defun font-lock-fontify-syntactically-region (start end &optional loudly) +; "Put proper face on each string and comment between START and END. +;START should be at the beginning of a line." +; (let ((synstart (if comment-start-skip +; (concat "\\s\"\\|" comment-start-skip) +; "\\s\"")) +; (comstart (if comment-start-skip +; (concat "\\s<\\|" comment-start-skip) +; "\\s<")) +; state prev prevstate) +; (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) +; (save-restriction +; (widen) +; (goto-char start) +; ;; +; ;; Find the state at the `beginning-of-line' before `start'. +; (if (eq start font-lock-cache-position) +; ;; Use the cache for the state of `start'. +; (setq state font-lock-cache-state) +; ;; Find the state of `start'. +; (if (null font-lock-beginning-of-syntax-function) +; ;; Use the state at the previous cache position, if any, or +; ;; otherwise calculate from `point-min'. +; (if (or (null font-lock-cache-position) +; (< start font-lock-cache-position)) +; (setq state (parse-partial-sexp (point-min) start)) +; (setq state (parse-partial-sexp font-lock-cache-position start +; nil nil font-lock-cache-state))) +; ;; Call the function to move outside any syntactic block. +; (funcall font-lock-beginning-of-syntax-function) +; (setq state (parse-partial-sexp (point) start))) +; ;; Cache the state and position of `start'. +; (setq font-lock-cache-state state +; font-lock-cache-position start)) +; ;; +; ;; If the region starts inside a string, show the extent of it. +; (if (nth 3 state) +; (let ((beg (point))) +; (while (and (re-search-forward "\\s\"" end 'move) +; (nth 3 (parse-partial-sexp beg (point) +; nil nil state)))) +; (put-text-property beg (point) 'face font-lock-string-face) +; (setq state (parse-partial-sexp beg (point) nil nil state)))) +; ;; +; ;; Likewise for a comment. +; (if (or (nth 4 state) (nth 7 state)) +; (let ((beg (point))) +; (save-restriction +; (narrow-to-region (point-min) end) +; (condition-case nil +; (progn +; (re-search-backward comstart (point-min) 'move) +; (forward-comment 1) +; ;; forward-comment skips all whitespace, +; ;; so go back to the real end of the comment. +; (skip-chars-backward " \t")) +; (error (goto-char end)))) +; (put-text-property beg (point) 'face font-lock-comment-face) +; (setq state (parse-partial-sexp beg (point) nil nil state)))) +; ;; +; ;; Find each interesting place between here and `end'. +; (while (and (< (point) end) +; (setq prev (point) prevstate state) +; (re-search-forward synstart end t) +; (progn +; ;; Clear out the fonts of what we skip over. +; (remove-text-properties prev (point) '(face nil)) +; ;; Verify the state at that place +; ;; so we don't get fooled by \" or \;. +; (setq state (parse-partial-sexp prev (point) +; nil nil state)))) +; (let ((here (point))) +; (if (or (nth 4 state) (nth 7 state)) +; ;; +; ;; We found a real comment start. +; (let ((beg (match-beginning 0))) +; (goto-char beg) +; (save-restriction +; (narrow-to-region (point-min) end) +; (condition-case nil +; (progn +; (forward-comment 1) +; ;; forward-comment skips all whitespace, +; ;; so go back to the real end of the comment. +; (skip-chars-backward " \t")) +; (error (goto-char end)))) +; (put-text-property beg (point) 'face +; font-lock-comment-face) +; (setq state (parse-partial-sexp here (point) nil nil state))) +; (if (nth 3 state) +; ;; +; ;; We found a real string start. +; (let ((beg (match-beginning 0))) +; (while (and (re-search-forward "\\s\"" end 'move) +; (nth 3 (parse-partial-sexp here (point) +; nil nil state)))) +; (put-text-property beg (point) 'face font-lock-string-face) +; (setq state (parse-partial-sexp here (point) +; nil nil state)))))) +; ;; +; ;; Make sure `prev' is non-nil after the loop +; ;; only if it was set on the very last iteration. +; (setq prev nil))) +; ;; +; ;; Clean up. +; (and prev (remove-text-properties prev end '(face nil))))) + (defun font-lock-lisp-like (mode) ;; Note: (or (get mode 'font-lock-lisp-like) (string-match ...)) is ;; not enough because the property needs to be able to specify a nil ＠＠ -1665,12 +1786,12 ＠＠ ((and (boundp 'lazy-shot-mode) lazy-shot-mode) (lazy-shot-mode -1)))) -;; Do something special for these packages after fontifying. I prefer a hook. +; Do something special for these packages after fontifying. I prefer a hook. (defun font-lock-after-fontify-buffer () (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) - (fast-lock-after-fontify-buffer)) + (declare-fboundp (fast-lock-after-fontify-buffer))) ((and (boundp 'lazy-lock-mode) lazy-lock-mode) - (lazy-lock-after-fontify-buffer)))) + (declare-fboundp (lazy-lock-after-fontify-buffer)))))  ;; Various functions. Index: lisp/lisp-mode.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/lisp-mode.el,v retrieving revision 1.10.2.9 diff -u -w -r1.10.2.9 lisp-mode.el --- lisp-mode.el 2001/02/19 23:26:32 1.10.2.9 +++ lisp-mode.el 2001/02/24 00:35:15 ＠＠ -101,6 +101,9 ＠＠ :active (fboundp 'untrace-all)] "---" ["%_Comment Out Region" comment-region :active (region-exists-p)] + ["Unc%_omment Region" (comment-region (region-beginning) + (region-end) '(4)) + :active (region-exists-p)] "---" ["%_Indent Region or Balanced Expression" ,(popup-wrap '(if (region-exists-p) Index: lisp/startup.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/startup.el,v retrieving revision 1.24.2.27 diff -u -w -r1.24.2.27 startup.el --- startup.el 2001/02/12 12:58:36 1.24.2.27 +++ startup.el 2001/02/24 00:35:16 ＠＠ -30,11 +30,39 ＠＠ ;; This file is dumped with XEmacs. -;; -batch, -t, and -nw are processed by main() in emacs.c and are -;; never seen by lisp code. - -;; -version and -help are special-cased as well: they imply -batch, -;; but are left on the list for lisp code to process. +;; It handles the all aspects of startup once the C code has finished +;; initializing itself. Entry from C is through the function set in +;; the `top-level' variable, which is normally `normal-top-level'. At +;; the point that `normal-top-level' has been invoked: +;; +;; (1) the dumped Elisp files are available. Either they were loaded +;; during this invocation of temacs and it was then converted to +;; XEmacs using the run-temacs mechanism, or (more likely) the +;; loadup and dumping occurred at some point in the past and we +;; just read in the dumped data. +;; +;; (2) All C subsystems have been initialized. +;; +;; (3) A "stream" device has been created, which does I/O over stdin +;; and stdout. This is the only device we have available and our +;; only means of communication, other than disk files. +;; +;; (4) The command-line arguments have been sorted according to +;; priority specs (this implies that the names of all arguments +;; must be hard-coded into emacs.c), and certain low-level +;; arguments such as -sd, -t, -nd, -nw, -batch, etc. have been +;; processed by main_1() and removed. (NOTE: main_1() is the name +;; in the source code, but in the object file it has some other +;; name, such as xemacs_21_2_34_mips_sgi_irix6().) Certain other +;; arguments such as -version and -help are partially-processed, +;; triggering some special behavior but being left on the list for +;; further processing by the Lisp code. +;; +;; The job of the code here is to process the remaining command-line +;; args, set up the various paths, locate where all the packages are +;; and set things up for them (initialize the load path, read in the +;; autoloads, etc.), read in the init files, display the splash +;; screen, and set up any remaining environment-dependent variables. ;;; Code:  ＠＠ -43,7 +71,8 ＠＠ (defvar command-line-processed nil "t once command line has been processed") (defconst startup-message-timeout 12000) ; More or less disable the timeout -(defconst splash-frame-timeout 7) ; interval between splash frame elements +(defconst splash-screen-timeout 7) ; interval between splash frame elements +(defconst splash-screen-circulate nil) ; disable obnoxious auto-circulation (defconst inhibit-startup-message nil "*Non-nil inhibits the initial startup message. ＠＠ -565,14 +594,19 ＠＠ (push (pop args) new-args))) (t (push arg new-args)))) - (setq init-file-user (and load-user-init-file-p "")) + (with-obsolete-variable 'init-file-user + (setq init-file-user (and load-user-init-file-p ""))) (nreverse new-args))) (defconst initial-scratch-message "\ ;; This buffer is for notes you don't want to save, and for Lisp evaluation. ;; If you want to create a file, first visit that file with C-x C-f, -;; then enter the text in that file's own buffer. +;; then enter the text in that file's own buffer. (C-x is the standard +;; XEmacs abbreviation for `Control+X', i.e. hold down the Control key +;; while hitting the X key.) +;; +;; For Lisp evaluation, type an expression, move to the end and hit C-j. " "Initial message displayed in *scratch* buffer at startup. ＠＠ -909,7 +943,7 ＠＠ (throw 'tmout t) (error nil))) nil)) - (setq circ-tmout (display-splash-frame)) + (setq circ-tmout (display-splash-screen)) (or nil;; (pos-visible-in-window-p (point-min)) (goto-char (point-min))) (sit-for 0) ＠＠ -965,6 +999,7 ＠＠ (goto-line line) (setq line nil)))))))) + (defvar startup-presentation-hack-keymap (let ((map (make-sparse-keymap))) (set-keymap-name map 'startup-presentation-hack-keymap) ＠＠ -1007,7 +1042,7 ＠＠ (format "Evaluate %S" e) (symbol-name e))) -(defun splash-frame-present-hack (e v) +(defun splash-screen-present-hack (e v) ;; (set-extent-property e 'mouse-face 'highlight) ;; (set-extent-property e 'keymap ;; startup-presentation-hack-keymap) ＠＠ -1033,13 +1068,15 ＠＠ (when (search-forward "." nil t) (delete-region (1- (point)) (point-max)))))) -(defun splash-frame-present (l) +;; parse one page description (see `splash-screen-body') and display +;; at point. +(defun splash-screen-present (l) (cond ((stringp l) (insert l)) ((eq (car-safe l) 'face) ;; (face name string) (let ((p (point))) - (splash-frame-present (elt l 2)) + (splash-screen-present (elt l 2)) (if (fboundp 'set-extent-face) (set-extent-face (make-extent p (point)) (elt l 1))))) ＠＠ -1052,16 +1089,16 ＠＠ (if (fboundp 'set-extent-face) (let ((e (make-extent p (point)))) (set-extent-face e 'bold) - (splash-frame-present-hack e c))))) + (splash-screen-present-hack e c))))) ((eq (car-safe l) 'funcall) ;; (funcall (fun . args) string) (let ((p (point))) - (splash-frame-present (elt l 2)) + (splash-screen-present (elt l 2)) (if (fboundp 'set-extent-face) - (splash-frame-present-hack (make-extent p (point)) + (splash-screen-present-hack (make-extent p (point)) (elt l 1))))) ((consp l) - (mapcar 'splash-frame-present l)) + (mapcar 'splash-screen-present l)) (t (error "WTF!?")))) ＠＠ -1090,8 +1127,31 ＠＠ (error "startup-center-spaces: bad arg"))))) (+ left-margin (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth))))) + +;; the splash screen originated in 19.10 as splash-screen-*. When +;; Chuck made the global screen->frame change for 19.12, he +;; accidentally changed these too. This randomness is getting on my +;; nerves, so let's fix it and provide minimal aliases for the +;; `locale' mule package. --ben + +; (make-obsolete 'splash-frame-body 'splash-screen-body) + +;; returns either of vector of page descriptions, each describing one +;; screenful of information, or just one such page descriptions Each +;; page description is a list of textual elements describing how to +;; display a section of text. The elements are processed in turn and +;; the results inserted one after the previous in a buffer. Each +;; textual element is either: + +;; -- a string, inserted as-is with no decoration. +;; -- a list of (face FACES "text"), where FACES is the name of a face +;; or a list of such names, and specifies the face(s) used when +;; displaying the text. +;; -- a list of (key COMMAND-NAME); the key sequence corresponding to +;; the command will be inserted, in boldface. +;; -- a list of textual elements. -(defun splash-frame-body () +(defun splash-screen-body () `[((face (blue bold underline) "\nDistribution, copying license, warranty:\n\n") "Please visit the XEmacs website at http://www.xemacs.org !\n\n" ＠＠ -1122,13 +1182,14 ＠＠ ": conditions to give out copies of XEmacs\n") ((key describe-distribution) ": how to get the latest version\n") - "\n--\n" + "\n" (face italic "\ Copyright (C) 1985-1999 Free Software Foundation, Inc. Copyright (C) 1990-1994 Lucid, Inc. Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved. -Copyright (C) 1994-1996 Board of Trustees, University of Illinois -Copyright (C) 1995-1996 Ben Wing\n")) +Copyright (C) 1994-1996 Board of Trustees, University of Illinois. +Copyright (C) 1995-2001 Ben Wing.\n\n") + (face blue "Press n for the next screen...")) ((face (blue bold underline) "\nInformation, on-line help:\n\n") "XEmacs comes with plenty of documentation...\n\n" ＠＠ -1145,16 +1206,22 ＠＠ ((key help-command) ": get help on using XEmacs (also available through the " (face bold "Help") " menu)\n") - ((key info) ": read the on-line documentation\n\n") - ((key describe-project) ": read about the GNU project\n") - ((key about-xemacs) ": see who's developing XEmacs\n")) + ((key info) ": read the on-line documentation\n") + ((key view-sample-init-el) + ": view the sample init.el file (also available through the " + (face bold "Help") " menu)\n\n") + ;; no point -- we're not GNU. + ;; ((key describe-project) ": read about the GNU project\n") + ((key about-xemacs) ": see who's developing XEmacs\n\n") + (face blue "Press n for the next screen...")) ((face (blue bold underline) "\nUseful stuff:\n\n") "Things that you should know rather quickly...\n\n" ((key find-file) ": visit a file\n") ((key save-buffer) ": save changes\n") ((key advertised-undo) ": undo changes\n") - ((key save-buffers-kill-emacs) ": exit XEmacs\n")) + ((key save-buffers-kill-emacs) ": exit XEmacs\n\n") + (face blue "Press n for the first screen...")) ]) ;; I really hate global variables, oh well. ＠＠ -1163,19 +1230,30 ＠＠ ;This function should return an initialized glyph if it is used.") ;; This will hopefully go away when gettext is functional. -(defconst splash-frame-static-body +(defconst splash-screen-static-body `(,(emacs-version) "\n\n" (face italic "`C-' means the control key,`M-' means the meta key\n\n"))) +;; temporary support for old locale files. +(define-obsolete-variable-alias 'splash-frame-static-body + 'splash-screen-static-body) + +;; CLIENT-DATA is a vector [INDEX-OF-NEXT-TO-SHOW POS BUFFER +;; PAGE-DESCS], where PAGE-DESCS is a vector of splash-screen page +;; descriptions of the format described in `splash-screen-body', +;; INDEX-OF-NEXT-TO-SHOW points to the next page description in the +;; vector to show, BUFFER is where to display the data, and POS the +;; position where to start; all text after this in the buffer is +;; deleted. After the page description is shown, the index is bumped +;; to the next page description, wrapping around appropriately. - -(defun circulate-splash-frame-elements (client-data) +(defun circulate-splash-screen-elements (client-data) (with-current-buffer (aref client-data 2) (let ((buffer-read-only nil) (elements (aref client-data 3)) (indice (aref client-data 0))) (goto-char (aref client-data 1)) (delete-region (point) (point-max)) - (splash-frame-present (aref elements indice)) + (splash-screen-present (aref elements indice)) (set-buffer-modified-p nil) (aset client-data 0 (if (= indice (- (length elements) 1)) ＠＠ -1183,47 +1261,66 ＠＠ (1+ indice ))) ))) -;; #### This function now returns the (possibly nil) timeout circulating the -;; splash-frame elements -(defun display-splash-frame () +(defun display-splash-screen () + ;; display the splash screen in the current buffer and put it in the + ;; current window. Return the (possibly nil) timeout circulating + ;; the splash-screen elements. (let ((logo xemacs-logo) (buffer-read-only nil) (cramped-p (eq 'tty (console-type)))) (unless cramped-p (insert "\n")) (indent-to (startup-center-spaces logo)) (set-extent-begin-glyph (make-extent (point) (point)) logo) - ;;(splash-frame-present-hack (make-extent p (point)) 'about-xemacs)) + ;;(splash-screen-present-hack (make-extent p (point)) 'about-xemacs)) (insert "\n\n") - (splash-frame-present splash-frame-static-body) + (splash-screen-present splash-screen-static-body) (splash-hack-version-string) (goto-char (point-max)) (let* ((after-change-functions nil) ; no font-lock, thank you - (elements (splash-frame-body)) - (client-data `[ 1 ,(point) ,(current-buffer) ,elements ]) + (elements (if (fboundp 'splash-frame-body) + (declare-fboundp (splash-frame-body)) + (splash-screen-body))) + (client-data `[ 0 ,(point) ,(current-buffer) ,elements ]) tmout) + (pop-to-buffer (current-buffer)) + (delete-other-windows) (if (listp elements) ;; A single element to display - (splash-frame-present (splash-frame-body)) + (splash-screen-present elements) ;; several elements to rotate - (splash-frame-present (aref elements 0)) - (setq tmout (add-timeout splash-frame-timeout - 'circulate-splash-frame-elements - client-data splash-frame-timeout))) + (if (not splash-screen-circulate) + (let (pare-pelo-amor-de-deus) + (while (not pare-pelo-amor-de-deus) + (circulate-splash-screen-elements client-data) + (sit-for 0) + (let ((keys (read-key-sequence nil))) + (unless (and (= 1 (length keys)) + (key-press-event-p (aref keys 0)) + (memq (event-to-character (aref keys 0)) + '(?n ?N))) + (setq unread-command-events + (append unread-command-events keys nil)) + (setq pare-pelo-amor-de-deus t))))) + (splash-screen-present (aref elements 0)) + (setq tmout (add-timeout splash-screen-timeout + 'circulate-splash-screen-elements + client-data splash-screen-timeout)))) (set-buffer-modified-p nil) tmout))) ;; (let ((present-file ;; #'(lambda (f) -;; (splash-frame-present +;; (splash-screen-present ;; (list 'funcall ;; (list 'find-file-other-window ;; (expand-file-name f data-directory)) ;; f))))) ;; (insert "For customization examples, see the files ") -;; (funcall present-file "sample.emacs") +;; (funcall present-file "sample.init.el") ;; (insert " and ") ;; (funcall present-file "sample.Xdefaults") ;; (insert (format "\nin the directory %s." data-directory))) + (defun startup-set-invocation-environment () ;; XEmacs -- Steven Baur says invocation directory is nil if you ;; try to use XEmacs as a login shell. Index: info/dir =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/info/dir,v retrieving revision 1.28.2.2 diff -u -w -r1.28.2.2 dir --- dir 1999/06/03 17:23:08 1.28.2.2 +++ dir 2001/02/24 00:35:16 ＠＠ -36,26 +36,23 ＠＠ XEmacs 21.2 =========== -* Info: (info). Documentation browsing system. -* XEmacs:: The extensible user-friendly self-documenting text editor. - This manual is for XEmacs 21.2 -* Lispref:: XEmacs Lisp technical reference. - This manual is for XEmacs 21.2. -* New-Users-Guide:: XEmacs New User's Guide for XEmacs 21.2. +* XEmacs:: XEmacs User's Manual. +* Lispref:: XEmacs Lisp Reference Manual. +* New-Users-Guide:: Getting Started with XEmacs. * XEmacs-FAQ:: XEmacs Frequently Asked Questions for 21.2. +* Info:: Guide to Info, the XEmacs online documentation system. * Internals:: Guide to the internals of XEmacs. -* Emodules:: XEmacs dynamic loadable module support. - -Local Packages: +Other Documentation: * CL:: A Common Lisp compatibility package for Emacs-Lisp. -* Custom:: Customization Library for Emacs +* Custom:: Customization Library for Emacs. +* Emodules:: XEmacs dynamic loadable module support. * External-Widget:: Use XEmacs as a text widget inside of another program. -* Standards: (standards). GNU coding standards. +* Standards:: GNU coding standards. * Term:: A mode to control inferior processes (a comint replacement) * Termcap:: The termcap library, which enables application programs to handle all types of character-display terminals. -* Texinfo: (texinfo). The GNU documentation format. -* Widget:: An Emacs Lisp widget library +* Texinfo:: The GNU documentation format. +* Widget:: An Emacs Lisp widget library. Index: etc/README =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/etc/README,v retrieving revision 1.6.2.1 diff -u -w -r1.6.2.1 README --- README 1998/07/12 09:55:14 1.6.2.1 +++ README 2001/02/24 00:35:16 ＠＠ -61,7 +61,7 ＠＠ refcard.ps.gz Postscript version of XEmacs reference card refcard.tex XEmacs reference card sample.Xdefaults Example ~/.Xdefaults file -sample.emacs Example ~/.emacs file +sample.init.el Example ~/.xemacs/init.el file sink.xbm A Gnu icon sparcworks/ Support files for Sparcworks tests/ Testcases for external widget Index: etc/sample.emacs =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/etc/sample.emacs,v retrieving revision 1.12.2.2 diff -u -w -r1.12.2.2 sample.emacs --- sample.emacs 1998/12/19 00:48:13 1.12.2.2 +++ sample.emacs 2001/02/24 00:35:17 ＠＠ -1,159 +1,677 ＠＠ ;; -*- Mode: Emacs-Lisp -*- -;;; This is a sample .emacs file. +;; Copyright (C) 2000, 2001 Ben Wing. + +;; Author: Mostly Ben Wing <ben(a)xemacs.org&gt; +;; Maintainer: XEmacs Development Team +;; Keywords: sample, initialization + +;; This file is part of XEmacs. + +;; XEmacs 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. + +;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; #### to do: +;; -- #### also figure out how init.el and custom.el interact and put +;; documentation about it here. (perhaps it already exists +;; elsewhere?) +;; -- update the text below pointing to where else to find related +;; docs so that it's accurate and complete. +;; -- review stuff (e.g. the frame title changing code needs to be +;; fixed for windows, and should get some other usefulnesses such +;; as moving the %b closer to the beginning) for correctness, +;; usefulness, and up-to-dateness. +;; -- look through my init.el file and custom.el file put in various +;; things that i've got there that are generally useful, e.g. stuff +;; making XEmacs on windows work more like is expected. +;; -- correct the key bindings -- e.g. Mark is probably useless +;; because we have the shifted arrow keys. + +;;; This is a sample .emacs file. It can be used without modification +;;; as your +;;; +;;; In older versions of XEmacs, you put this file in your home +;;; directory. (Under MS Windows, that directory is controlled by the +;;; HOME environment variable and defaults to C:\. You can find out where +;;; XEmacs thinks your home directory is using +;;; +;;; ESC : (expand-file-name "~") +;;; +;;; . This means type ESC, then colon, then the following text, then hit +;;; return.) In more recent versions of XEmacs, this file has migrated to +;;; the .xemacs/ subdirectory and is called init.el. Other files are +;;; also located here, such as custom.el (the auto-generated file +;;; containing Customization options that you saved when using +;;; Options->Save Options). + +;;; Changes to your .emacs file will not take effect until the next +;;; time you start up XEmacs, unless you load it explicitly with +;;; +;;; M-x load-file RET ~/.emacs RET ;;; -;;; The .emacs file, which should reside in your home directory, allows you to -;;; customize the behavior of Emacs. In general, changes to your .emacs file -;;; will not take effect until the next time you start up Emacs. You can load -;;; it explicitly with `M-x load-file RET ~/.emacs RET'. -;;; -;;; There is a great deal of documentation on customization in the Emacs -;;; manual. You can read this manual with the online Info browser: type -;;; `C-h i' or select "Emacs Info" from the "Help" menu. +;;; There is a great deal of documentation on customization in the +;;; XEmacs User's Manual. You can read this manual with the online +;;; Info browser: Select Help->Info (Online Docs)->Info Contents (or +;;; type `C-h i') and then *middle-click* the XEmacs entry. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic Customization ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Enable the command `narrow-to-region' ("C-x n n"), a useful -;; command, but possibly confusing to a new user, so it's disabled by -;; default. -(put 'narrow-to-region 'disabled nil) +;; TIP: Control-L characters are ignored in Lisp files and are the +;; standard way of indicating major section divisions. You can enter +;; such a character using C-q C-l. + +;; Define a variable to indicate whether we're running XEmacs/Lucid +;; Emacs. (You do not have to defvar a global variable before using +;; it -- you can just call `setq' directly. It's clearer this way, +;; though. Note also how we check if this variable already exists +;; using `boundp', because it's defined in recent versions of +;; XEmacs.) + +(or (boundp 'running-xemacs) + (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) + +;; Define a function to make it easier to check which version we're +;; running. This function already exists in recent XEmacs versions, +;; and in fact all we've done is copied the definition. Note again +;; how we check to avoid clobbering an existing definition. (It's good +;; style to do this, in case some improvement was made to the +;; already-existing function -- otherwise we might subsitute an older +;; definition and possibly break some code elsewhere.) +;; +;; TIP: At this point you may be wondering how I wrote all these nice, +;; long, nicely-justified textual stretches -- didn't I go crazy +;; sticking in the semicolons everywhere and having to delete them and +;; rearrange everything whenever I wanted to make any corrections to +;; the text? The answer is -- of course not! Use M-q. This does all +;; the magic for you, justifying and breaking lines appropriately and +;; putting any necessary semicolons or whatever at the left (it +;; figures out what this ought to be by looking in a very clever +;; fashion at what's already at the beginning of each line in the +;; paragraph). You may need `filladapt' set up (it's +;; done below in this sample file) in order for this to work +;; properly. Finally, if you want to + +(or (fboundp 'emacs-version>=) + (defun emacs-version>= (major &optional minor patch) + "Return true if the Emacs version is >= to the given MAJOR, MINOR, + and PATCH numbers. +The MAJOR version number argument is required, but the other arguments +argument are optional. Only the Non-nil arguments are used in the test." + (let ((emacs-patch (or emacs-patch-level emacs-beta-version -1))) + (cond ((> emacs-major-version major)) + ((< emacs-major-version major) nil) + ((null minor)) + ((> emacs-minor-version minor)) + ((< emacs-minor-version minor) nil) + ((null patch)) + ((>= emacs-patch patch)))))) + +;; 19.13 was released ages ago (Sep. 1995), and lots of graphic and +;; window-system stuff doesn't work before then. + +(or (not running-xemacs) + (emacs-version>= 19 13) + (error "This init file does not support XEmacs before 19.13")) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Key Definitions ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Define a variable to indicate whether we're running XEmacs/Lucid Emacs. -;;; (You do not have to defvar a global variable before using it -- -;;; you can just call `setq' directly like we do for `emacs-major-version' -;;; below. It's clearer this way, though.) - -(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) - -;; Make the sequence "C-x w" execute the `what-line' command, -;; which prints the current line number in the echo area. -(global-set-key "\C-xw" 'what-line) - -;; set up the function keys to do common tasks to reduce Emacs pinky -;; and such. - -;; Make F1 invoke help -(global-set-key [f1] 'help-command) -;; Make F2 be `undo' -(global-set-key [f2] 'undo) -;; Make F3 be `find-file' -;; Note: it does not currently work to say -;; (global-set-key 'f3 "\C-x\C-f") -;; The reason is that macros can't do interactive things properly. +;;; Set up the function keys to do common tasks to reduce Emacs pinky +;;; and such. + +;; You can set a key sequence either to a command or to another key +;; sequence. (Use C-h k to map a key sequence to its command. Use C-h +;; w to go the other way.) +(global-set-key 'f1 "\C-xu") ;; Undo +(global-set-key 'f2 'kill-primary-selection) ;; Cut +(global-set-key 'f3 'copy-primary-selection) ;; Copy +(global-set-key 'f4 'yank-clipboard-selection) ;; Paste + +;; But unfortunately it does not currently work to say (e.g.) +;; (global-set-key 'f5 "\C-x\C-f") +;; The reason is that macros can't currently use the minibuffer. ;; This is an extremely longstanding bug in Emacs. Eventually, ;; it will be fixed. (Hopefully ..) -(global-set-key [f3] 'find-file) + +(global-set-key 'f5 'find-file) ;; C-x C-f +(global-set-key 'f7 'save-buffer) ;; C-x C-s +(global-set-key 'f9 'kill-line) ;; C-k + +;; Here we define our own function and then bind a key to it. + +(defun start-or-end-kbd-macro () + ;; A doc string. This is optional. + "Start defining a keyboard macro, or stop if we're already defining." + ;; IMPORTANT: Any function bound to a key MUST have an interactive spec, + ;; usually just the following line: + (interactive) + (if defining-kbd-macro + (end-kbd-macro) + (start-kbd-macro nil))) + +(global-set-key 'f8 'start-or-end-kbd-macro) +(global-set-key 'f10 'call-last-kbd-macro) ;; C-x e + +;; Note that you can refer to a key sequence either using an ASCII +;; string or the "long way", with vectors and conses. You saw above +;; (in a comment) the string form for specifying the key sequence `C-x +;; C-f', which is "\C-x\C-f". (For those curious, \C-x is just an +;; escape sequence that puts a ^X character into the string. Thus, +;; the string just mentioned really just contains two characters, a ^X +;; and a ^F.) The long way to specify the sequence `C-x C-f' would be +;; +;; [(control x) (control f)] +;; +;; The long format lets you specify all possible key sequences, while the +;; string form only lets you specify sequences involving ASCII characters +;; and/or modifiers and in fact only a subset of them. +;; +;; Other examples are: +;; +;; [(control x) n] +;; +;; (You can leave out the parens when there is no modifier specified in +;; the keystroke, and that's normally done.) +;; +;; [(shift control meta left)] +;; +;; (You can put more than one modifier in a keystroke.) +;; +;; (shift control meta left) +;; +;; (This is the same as the previous. when there's only one keystroke in +;; the sequence, you can leave out the brackets, and that's normally +;; done.) +;; +;; [(control x) (shift button3)] +;; +;; (You can refer to mouse buttons just like keys -- apply modifiers, +;; intermingle them in key sequences, etc. But there's only problem +;; here, which is that with the mouse you don't just have one possible +;; gesture, like with keys. You'd really like to control button-down, +;; button-up, button-click (down and up without selecting anything), +;; button drag, button double-click, etc. This is normally done by +;; binding your key sequence to `mouse-track', and then putting hooks +;; onto `mouse-track-click-hook', `mouse-track-drag-up-hook', etc. to +;; customize the specific behavior.) +;; +;; 'left +;; +;; (Ultimate reductionism -- no brackets, no parens. This is the form, in +;; that, that the 'f1, 'f2, etc. took, which where in fact "long" +;; forms.) +;; +;; '(control C) +;; +;; (You cannot use '(control shift c) here. This applies whenever Shift + +;; key translates to a single character. Note also that you can't use +;; "\C-C" either; this refers to the non-shifted C-c, just like "\C-c" +;; would.) +;; +;; '(control \() +;; (Put a backslash in front of characters used in Lisp syntax.) +;; +;; Also, you can find out the name of a key using C-h c. WARNING: +;; This does not report the correct name of the keys named `delete', +;; `backspace', `return', `tab', `space', `escape', and `linefeed'! +;; (More correct results can be achieved using +;; +;; ESC : (read-key-sequence "foo: ") +;; +;; .) -;; Make F4 be "mark", F5 be "copy", F6 be "paste" -;; Note that you can set a key sequence either to a command or to another -;; key sequence. -(global-set-key [f4] 'set-mark-command) -(global-set-key [f5] "\M-w") -(global-set-key [f6] "\C-y") - -;; Shift-F4 is "pop mark off of stack" -(global-set-key [(shift f4)] (lambda () (interactive) (set-mark-command t))) - -;; Make F7 be `save-buffer' -(global-set-key [f7] 'save-buffer) - -;; Make F8 be "start macro", F9 be "end macro", F10 be "execute macro" -(global-set-key [f8] 'start-kbd-macro) -(global-set-key [f9] 'end-kbd-macro) -(global-set-key [f10] 'call-last-kbd-macro) - -;; Here's an alternative binding if you don't use keyboard macros: -;; Make F8 be `save-buffer' followed by `delete-window'. -;;(global-set-key 'f8 "\C-x\C-s\C-x0") - -;; If you prefer delete to actually delete forward then you want to -;; uncomment the next line (or use `Customize' to customize this). -;; (setq delete-key-deletes-forward t) +;;;;;;;;;;;;;;;;;;;;;;;; +;; Keystrokes to conveniently switch buffers. -(cond (running-xemacs +(global-set-key 'f6 'switch-to-other-buffer) ;; M-C-l +(define-key global-map '(meta n) 'switch-to-next-buffer-in-group) +(define-key global-map '(meta p) 'switch-to-previous-buffer-in-group) +(define-key global-map '(meta N) 'switch-to-next-buffer) +(define-key global-map '(meta P) 'switch-to-previous-buffer) + +(defun switch-to-next-buffer (&optional n) + "Switch to the next-most-recent buffer. +This essentially rotates the buffer list forward. +N (interactively, the prefix arg) specifies how many times to rotate +forward, and defaults to 1. Buffers whose name begins with a space +\(i.e. \"invisible\" buffers) are ignored." + (interactive "p") + (dotimes (n (or n 1)) + (loop + do (bury-buffer (car (buffer-list))) + while (funcall buffers-tab-omit-function (car (buffer-list)))) + (switch-to-buffer (car (buffer-list))))) + +(defun switch-to-previous-buffer (&optional n) + "Switch to the previously most-recent buffer. +This essentially rotates the buffer list backward. +N (interactively, the prefix arg) specifies how many times to rotate +backward, and defaults to 1. Buffers whose name begins with a space +\(i.e. \"invisible\" buffers) are ignored." + (interactive "p") + (dotimes (n (or n 1)) + (loop + do (switch-to-buffer (car (last (buffer-list)))) + while (funcall buffers-tab-omit-function (car (buffer-list)))))) + +(defun switch-to-next-buffer-in-group (&optional n) + "Switch to the next-most-recent buffer in the current group. +This essentially rotates the buffer list forward. +N (interactively, the prefix arg) specifies how many times to rotate +forward, and defaults to 1. Buffers whose name begins with a space +\(i.e. \"invisible\" buffers) are ignored." + (interactive "p") + (dotimes (n (or n 1)) + (let ((curbuf (car (buffer-list)))) + (loop + do (bury-buffer (car (buffer-list))) + while (or (funcall buffers-tab-omit-function (car (buffer-list))) + (not (funcall buffers-tab-selection-function curbuf + (car (buffer-list))))))) + (switch-to-buffer (car (buffer-list))))) + +(defun switch-to-previous-buffer-in-group (&optional n) + "Switch to the previously most-recent buffer in the current group. +This essentially rotates the buffer list backward. +N (interactively, the prefix arg) specifies how many times to rotate +backward, and defaults to 1. Buffers whose name begins with a space +\(i.e. \"invisible\" buffers) are ignored." + (interactive "p") + (dotimes (n (or n 1)) + (let ((curbuf (car (buffer-list)))) + (loop + do (switch-to-buffer (car (last (buffer-list)))) + while (or (funcall buffers-tab-omit-function (car (buffer-list))) + (not (funcall buffers-tab-selection-function curbuf + (car (buffer-list))))))))) + +;;;;;;;;;;;;;;;;;;;;;;;; + +;; Other text keystrokes. + +;; Make a keystroke to insert a literal TAB character. (`C-q TAB' is +;; annoying because difficult to repeat.) Note that this does not work +;; in TTY frames, where TAB and Shift-TAB are indistinguishable. +(define-key global-map '(shift tab) 'tab-to-tab-stop) + +;; Toggle auto-filling. Useful with text but annoying with code. You +;; can manually fill with M-q. +(global-set-key '(meta f9) 'auto-fill-mode) + +;; You cannot say '(meta shift t) here -- see above. +(global-set-key '(meta T) 'transpose-line-down) +(global-set-key '(control T) 'transpose-line-up) + +;;;;;;;;;;;;;;;;;;;;;;;; + +;; Rearrange some inconvenient bindings. + +;; ESC ESC ESC is a useful command, but too long. ESC ESC would be +;; much more logical, but interferes with Meta + keypad/arrow keys on +;; TTY's. But most people only use window systems and no such problem +;; exists there, so set up the more logical binding there. ;; - ;; Code for any version of XEmacs/Lucid Emacs goes here +;; Note also the use of if vs. cond/when/unless/or/and to express +;; conditional statements. The difference is purely stylistic. + +(when (console-on-window-system-p) + (global-set-key '(meta escape) 'keyboard-escape-quit) + (define-key isearch-mode-map '(meta escape) 'isearch-cancel)) + +;; The standard definition of C-z causes iconification on window +;; systems, which is both useless and annoying. Instead, bind it to a +;; useful command that's not on any keys. (This also makes a neat +;; parallelism with M-z, which does zap-to-char.) Don't override the +;; TTY binding, which does "Suspend". If you want this new binding on +;; TTY's, and can train yourself to use C-x C-z to suspend, then +;; remove or comment out the `when' statement. (Here's the proper way +;; to comment out such a statement: ;; +;; ;(when (console-on-window-system-p) +;; (global-set-key "\C-z" 'zap-up-to-char) +;; ; ) +;; +;; To do this, I first moved the closing paren to a new line, +;; reindented with TAB, then added the semicolons.) + +(when (console-on-window-system-p) + (global-set-key "\C-z" 'zap-up-to-char)) + +;; When not on a TTY, remove the binding of C-x C-c, which normally +;; exits XEmacs. It's easy to hit this by mistake, and that can be +;; annoying. You can always quit with the "Exit XEmacs" option on the +;; File menu. + +(when (console-on-window-system-p) + (global-set-key "\C-x\C-c" nil)) + +;; Make C-k always delete the whole line, which is what most people want, +;; anyway. +(setq 'kill-whole-line 'always) +;; Meta-Shift-K does the old behavior (kill to end of line), and should +;; (hopefully) even work under TTY's. +(global-set-key '(meta K) 'historical-kill-line) + +;; The following commented-out code rearranges the keymap in an +;; unconventional but extremely useful way for programmers. Parens +;; and braces are both available without using the shift key (using +;; the bracket keys and f11/f12, respectively). Brackets (much less +;; used) are the shifted versions of the new paren keys (i.e. where +;; the braces normally are). +;; +;; The idea for this comes from Jamie Zawinski. +;; +;; NOTE: you can (semi-) conveniently uncomment a region using +;; C-u M-x comment-region, or the "Uncomment Region" menu item on the +;; Lisp menu in new enough versions of XEmacs. + +;(keyboard-translate ?[ ?() +;(keyboard-translate ?] ?)) +;(keyboard-translate ?{ ?[) +;(keyboard-translate ?} ?]) +;(keyboard-translate 'f11 ?{) +;(keyboard-translate 'f12 ?}) +;;; Older versions of XEmacs also need this, due to a bug in +;;; `keyboard-translate'. +;(global-set-key 'f11 "{") +;(global-set-key 'f12 "}") + +;; Here's another switch, a bit more controversial than the above. It +;; switches backquote and underscore, so that underscore (ubiquitous +;; in C code) is available without shifting. (This is Ben Wing's +;; idea.) +;(keyboard-translate ?_ ?`) +;(keyboard-translate ?` ?_) + +;;;;;;;;;;;;;;;;;;;;;;;; + +;; Useful programming-related keystrokes. + +(global-set-key '(shift f4) 'next-error) ;; C-x ` +(global-set-key '(control f4) 'previous-error) +(global-set-key '(shift f5) 'find-library) +(global-set-key '(control f5) 'find-function) +(global-set-key '(meta f5) 'find-variable) +(global-set-key '(meta f7) 'add-change-log-entry) +;; Edebug is a source-level debugger for Emacs Lisp programs. Put +;; the cursor at the end of a function definition and "instrument" it +;; with this command; then, you can single step through it the next +;; time it's run. +(global-set-key '(meta f8) 'edebug-defun) + +;; This nicely parallels M-*, which pops the tag stack. See below for +;; how to set up tags. +(global-set-key '(control *) 'find-tag-at-point) + +;; Define a function to conveniently determine where time is being +;; spent when executing commands or Lisp code. +(defun toggle-profiling () + "Start profiling, or stop it and print results. +This lets you figure out where time is being spent when executing Lisp code." + (interactive) + (if (profiling-active-p) + (progn + (stop-profiling) + (message "...Finished profiling") + (profile-results)) + (message "Profiling...") + (clear-profiling-info) + (start-profiling))) + +;; Note that sequences of C-c plus a letter are specifically +;; reserved for users and should never be bound by any packages. + +(global-set-key [(control c) p] 'toggle-profiling) + +;; LISPM bindings of Control-Shift-C and Control-Shift-E. +;; See comment above about bindings like this. +(define-key emacs-lisp-mode-map '(control C) 'compile-defun) +(define-key emacs-lisp-mode-map '(control E) 'eval-defun) + +;;;;;;;;;;;;;;;;;;;;;;;; + +;; Numeric keypad. + +;; The numeric keypad as a whole is underused, and it's a good source +;; of keys to bind to commands. Here we add some useful bindings. +;; Because this is a sample file and I want to avoid unpleasant +;; surprises for novices, I don't actually bind the shared +;; numeric/cursor-motion keys because +;; +;; (a) someone keypads don't have separate motion keys (e.g. laptops?), and +;; (b) TTY's and some X servers might not distinguish the regular and +;; numeric-keypad motion keys. + +;; `kill-current-buffer' (defined below) deletes the current +;; buffer. (Don't worry, you will be prompted to save if it's +;; modified.) By repeatedly pressing this, you can conveniently reduce +;; the number of open buffers to a manageable size after you've opened +;; a whole bunch of files and finished working on them. SHIFT plus +;; keypad minus kills both the current buffer and its window. + +(global-set-key 'kp-subtract 'kill-current-buffer) +(global-set-key '(shift kp-subtract) 'kill-current-buffer-and-window) +;; Ugh, modes that use `suppress-keymap' and are dumped with XEmacs will +;; need their own definition. There is no easy way to fix this. +(define-key help-mode-map 'kp-subtract 'kill-current-buffer) +(define-key help-mode-map '(shift kp-subtract) + 'kill-current-buffer-and-window) +(define-key list-mode-map 'kp-subtract 'kill-current-buffer) +(define-key list-mode-map '(shift kp-subtract) + 'kill-current-buffer-and-window) + +(defun kill-current-buffer () + (interactive) + (kill-buffer (current-buffer))) + +(defun kill-current-buffer-and-window () + (interactive) + (kill-buffer (current-buffer)) + (delete-window)) + +(defun grep-c-files () + (interactive) + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.[chCH]" + ; i wanted to also use *.cc and *.hh. + ; see long comment below under Perl. + ) + (length grep-command)))) + (call-interactively 'grep))) + +(defun grep-lisp-files () + (interactive) + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.el" + ; i wanted to also use *.cc and *.hh. + ; see long comment below under Perl. + ) + (length grep-command)))) + (call-interactively 'grep))) + +;; This repeatedly selects larger and larger balanced expressions +;; around the cursor. Once you have such an expression marked, you +;; can expand to the end of the following expression with C-M-SPC and +;; to the beginning of the previous with M-left. + +(defun clear-select () + (interactive "_") ;this means "preserve the active region after this command" + (backward-up-list 1) + (let ((end (save-excursion (forward-sexp) (point)))) + (push-mark end nil t))) + +;; #### no kp-divide because it doesn't (currently) work on MS Windows +;; -- always reports as /. #### this should be fixable. +(global-set-key 'kp-add 'query-replace) +(global-set-key '(shift kp-add) 'query-replace-regexp) +(global-set-key '(control kp-add) 'grep-c-files) +(global-set-key '(meta kp-add) 'grep-lisp-files) +(global-set-key 'clear 'clear-select) +;; Note that you can use a "lambda" expression (an anonymous function) +;; in place of a function name. This function would be called +;; `pop-local-mark' and lets you repeatedly cycle back through recent +;; marks (marks are set whenever you begin a selection, begin a +;; successful search, are about to jump to the beginning or end of the +;; buffer, etc.). +(global-set-key 'kp-enter (lambda () (interactive) (set-mark-command t))) +(global-set-key '(shift kp-enter) 'repeat-complex-command) +(global-set-key '(control kp-enter) 'eval-expression) + +;;;;;;;;;;;;;;;;;;;;;;;; + +;; Misc. + +;; If you want button2 to insert the selected text +;; at point (where the text cursor is), instead of at the +;; position clicked, uncomment the following: + +;(setq mouse-yank-at-point t) + +;; If you like the FSF Emacs binding of button3 (single-click +;; extends the selection, double-click kills the selection), +;; uncomment the following: + +;(define-key global-map 'button3 'mouse-track-adjust) + +;(add-hook 'mouse-track-click-hook +; (lambda (event count) +; (if (or (/= (event-button event) 3) +; (/= count 2)) +; nil ;; do the normal operation +; (kill-region (point) (mark)) +; t ;; don't do the normal operations. +; ))) + +;; Uncomment this to enable "sticky modifier keys". With sticky +;; modifier keys enabled, you can press and release a modifier key +;; before pressing the key to be modified, like how the ESC key works +;; always. If you hold the modifier key down, however, you still get +;; the standard behavior. I personally think this is the best thing +;; since sliced bread (and a *major* win when it comes to reducing +;; Emacs pinky), but it's disorienting at first so I'm not enabling it +;; here by default. +;(setq modifier-keys-are-sticky t) + +;; Enable the command `narrow-to-region' ("C-x n n"). It's a useful +;; command, but possibly confusing to a new user, so it's disabled by +;; default. +(put 'narrow-to-region 'disabled nil) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Change Some Basic Behaviors ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Change the values of some variables. ;; (t means true; nil means false.) ;; - ;; Use the "Describe Variable..." option on the "Help" menu - ;; to find out what these variables mean. - (setq find-file-use-truenames nil +;; Use C-h v or Help->Commands, Variables, Keys->Variable... to find +;; out what these variables mean. +(setq find-file-compare-truenames t minibuffer-confirm-incomplete t complex-buffers-menu-p t - next-line-add-newlines nil - mail-yank-prefix "> " - kill-whole-line t + minibuffer-max-depth nil ) ;; When running ispell, consider all 1-3 character words as correct. (setq ispell-extra-args '("-W" "3")) - (cond ((or (not (fboundp 'device-type)) - (equal (device-type) 'x) - (equal (device-type) 'mswindows)) - ;; Code which applies only when running emacs under X or - ;; MicroSoft Windows goes here. (We check whether the - ;; function `device-type' exists before using it. In - ;; versions before 19.12, there was no such function. - ;; If it doesn't exist, we simply assume we're running - ;; under X -- versions before 19.12 only supported X.) - - ;; Remove the binding of C-x C-c, which normally exits emacs. - ;; It's easy to hit this by mistake, and that can be annoying. - ;; Under X, you can always quit with the "Exit Emacs" option on - ;; the File menu. - (global-set-key "\C-x\C-c" nil) - - ;; Uncomment this to enable "sticky modifier keys" in 19.13 - ;; and up. With sticky modifier keys enabled, you can - ;; press and release a modifier key before pressing the - ;; key to be modified, like how the ESC key works always. - ;; If you hold the modifier key down, however, you still - ;; get the standard behavior. I personally think this - ;; is the best thing since sliced bread (and a *major* - ;; win when it comes to reducing Emacs pinky), but it's - ;; disorienting at first so I'm not enabling it here by - ;; default. +;;; pending-delete-mode causes typed text to replace a selection, +;;; rather than append -- standard behavior under all window systems +;;; nowadays. + +(pending-delete-mode 1) + +(when (eq system-type 'windows-nt) + ;; Get mail working under Windows. + (setq send-mail-function 'smtpmail-send-it) + (setq smtpmail-debug-info t) + ;; Substitute your info here. + ;(setq user-mail-address &quot;ben(a)xemacs.org&quot;) + ;(setq user-full-name "Ben Wing") + ;(setq smtpmail-smtp-server "pop.tcsn.uswest.net") + + ;; Make Alt+accelerator traverse to the menu in new enough XEmacs + ;; versions. Note that this only overrides Meta bindings that would + ;; actually invoke a menu, and that none of the most common commands + ;; are overridden. You can use ESC+key to access the overridden + ;; ones if necessary. + (setq menu-accelerator-enabled 'menu-force) + + ;; Make Cygwin `make' work inside a shell buffer. + (setenv "MAKE_MODE" "UNIX")) + +;; This shows how to set up the XEmacs side of tags. (To create the +;; TAGS table, use the `etags' program found in the XEmacs bin +;; directory. Run it in the root directory of your source tree and +;; specify all source and include files on the command line.) +;(setq tag-table-alist +; '( +; ;; Everywhere in the /src/xemacs/gui/ source tree will use the TAGS +; ;; file in /src/xemacs/gui/. +; ("/src/xemacs/gui/" . "/src/xemacs/gui/") +; ;; Everywhere in the /src/xemacs/mule/ source tree will use the TAGS +; ;; file in /src/xemacs/mule/. +; ("/src/xemacs/mule/" . "/src/xemacs/mule/") +; ;; etc. +; ("/src/xemacs/fixup/" . "/src/xemacs/fixup/") +; ("/src/emacs/emacs-20.6/" . "/src/emacs/emacs-20.6/") +; ("/src/xemacs/latest/" . "/src/xemacs/latest/") +; ;; Everywhere else will use the TAGS file in +; ;; /src/xemacs/fixup/. +; ("" . "/src/xemacs/fixup/") +; )) - ;;(setq modifier-keys-are-sticky t) - ;; This changes the variable which controls the text that goes - ;; in the top window title bar. (However, it is not changed - ;; unless it currently has the default value, to avoid - ;; interfering with a -wn command line argument I may have - ;; started emacs with.) - (if (equal frame-title-format "%S: %b") +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Change Some Aspects of GUI Appearance ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Changes the text in the window title bar, to switch to MS Windows +;; format (filename goes first, for best identification in icons) and +;; add the version and full executable path. (However, it is not +;; changed unless it currently has the default value, to avoid +;; interfering with a -wn command line argument I may have started +;; XEmacs with.) + +(if (or (equal frame-title-format "%S: %b") + (equal frame-title-format "%b - XEmacs") (setq frame-title-format - (concat "%S: " invocation-directory invocation-name - " [" emacs-version "]" - (if nil ; (getenv "NCD") - "" - " %b")))) + (concat "%b - XEmacs " + (progn (string-match "\\(.*?\\)\\( XEmacs Lucid\\)?$" + emacs-version) + (match-string 1 emacs-version)) + " [" invocation-directory invocation-name "]")))) - ;; If we're running on display 0, load some nifty sounds that - ;; will replace the default beep. But if we're running on a - ;; display other than 0, which probably means my NCD X terminal, - ;; which can't play digitized sounds, do two things: reduce the - ;; beep volume a bit, and change the pitch of the sound that is - ;; made for "no completions." - ;; - ;; (Note that sampled sounds only work if XEmacs was compiled - ;; with sound support, and we're running on the console of a - ;; Sparc, HP, or SGI machine, or on a machine which has a - ;; NetAudio server; otherwise, you just get the standard beep.) - ;; - ;; (Note further that changing the pitch and duration of the - ;; standard beep only works with some X servers; many servers - ;; completely ignore those parameters.) +;; Load some nifty sounds that will replace the default beep. ;; +;; (Note that sampled sounds only work if XEmacs was compiled with +;; sound support and we're running on MS Windows, on a machine which +;; has a NetAudio or ESD server, or on the console of a Linux, Sparc, +;; HP, or SGI machine. Otherwise, you just get the standard beep.) + (cond ((or (and (getenv "DISPLAY") (string-match ":0" (getenv "DISPLAY"))) (and (eq (console-type) 'mswindows) ＠＠ -165,13 +683,6 ＠＠ (append sound-alist '((no-completion :pitch 500)))) )) - ;; Make `C-x C-m' and `C-x RET' be different (since I tend - ;; to type the latter by accident sometimes.) - (define-key global-map [(control x) return] nil) - - ;; Change the pointer used when the mouse is over a modeline - (set-glyph-image modeline-pointer-glyph "leftbutton") - ;; Change the continuation glyph face so it stands out more (and (fboundp 'make-face-bold) (boundp 'continuation-glyph) ＠＠ -195,76 +706,24 ＠＠ ;; because we know it will just cause some error messages. (if (featurep 'xpm) (let ((file (expand-file-name "recycle.xpm" data-directory))) - (if (condition-case error + (if (condition-case nil ;; check to make sure we can use the pointer. (make-image-instance file nil '(pointer)) (error nil)) ; returns nil if an error occurred. (set-glyph-image gc-pointer-glyph file)))) - - (when (featurep 'menubar) - ;; Add `dired' to the File menu - (add-menu-button '("File") ["Edit Directory" dired t]) - - ;; Here's a way to add scrollbar-like buttons to the menubar - (add-menu-button nil ["Top" beginning-of-buffer t]) - (add-menu-button nil ["<<<" scroll-down t]) - (add-menu-button nil [" . " recenter t]) - (add-menu-button nil [">>>" scroll-up t]) - (add-menu-button nil ["Bot" end-of-buffer t])) - - ;; Change the behavior of mouse button 2 (which is normally - ;; bound to `mouse-yank'), so that it inserts the selected text - ;; at point (where the text cursor is), instead of at the - ;; position clicked. - ;; - ;; Note that you can find out what a particular key sequence or - ;; mouse button does by using the "Describe Key..." option on - ;; the Help menu. - (setq mouse-yank-at-point t) - - ;; When editing C code (and Lisp code and the like), I often - ;; like to insert tabs into comments and such. It gets to be - ;; a pain to always have to use `C-q TAB', so I set up a more - ;; convenient binding. Note that this does not work in - ;; TTY frames, where tab and shift-tab are indistinguishable. - (define-key global-map '(shift tab) 'self-insert-command) - - ;; LISPM bindings of Control-Shift-C and Control-Shift-E. - ;; Note that "\C-C" means Control-C, not Control-Shift-C. - ;; To specify shifted control characters, you must use the - ;; more verbose syntax used here. - (define-key emacs-lisp-mode-map '(control C) 'compile-defun) - (define-key emacs-lisp-mode-map '(control E) 'eval-defun) - - ;; If you like the FSF Emacs binding of button3 (single-click - ;; extends the selection, double-click kills the selection), - ;; uncomment the following: - ;; Under 19.13, the following is enough: - ;(define-key global-map 'button3 'mouse-track-adjust) - - ;; But under 19.12, you need this: - ;(define-key global-map 'button3 - ; (lambda (event) - ; (interactive "e") - ; (let ((default-mouse-track-adjust t)) - ; (mouse-track event)))) +;(when (featurep 'menubar) +; ;; Add `dired' to the File menu +; (add-menu-button '("File") ["Edit Directory" dired]) + +; ;; Here's a way to add scrollbar-like buttons to the menubar +; (add-menu-button nil ["Top" beginning-of-buffer]) +; (add-menu-button nil ["<<<" scroll-down]) +; (add-menu-button nil [" . " recenter]) +; (add-menu-button nil [">>>" scroll-up]) +; (add-menu-button nil ["Bot" end-of-buffer])) - ;; Under both 19.12 and 19.13, you also need this: - ;(add-hook 'mouse-track-click-hook - ; (lambda (event count) - ; (if (or (/= (event-button event) 3) - ; (/= count 2)) - ; nil ;; do the normal operation - ; (kill-region (point) (mark)) - ; t ;; don't do the normal operations. - ; ))) - - )) - - )) - ;; Oh, and here's a cute hack you might want to put in the sample .emacs ;; file: it changes the color of the window if it's not on the local ;; machine, or if it's running as root: ＠＠ -273,11 +732,7 ＠＠ ;; remote emacs background: palegreen1 ;; root emacs background: coral2 (cond - ((and (string-match "XEmacs" emacs-version) - (eq window-system 'x) - (boundp 'emacs-major-version) - (= emacs-major-version 19) - (>= emacs-minor-version 12)) + ((and running-xemacs (console-on-window-system-p)) (let* ((root-p (eq 0 (user-uid))) (dpy (or (getenv "DISPLAY") "")) (remote-p (not ＠＠ -298,55 +753,42 ＠＠ (set-face-background (car faces) bg))) (setq faces (cdr faces))))))))) - -;;; Older versions of emacs did not have these variables -;;; (emacs-major-version and emacs-minor-version.) -;;; Let's define them if they're not around, since they make -;;; it much easier to conditionalize on the emacs version. - -(if (and (not (boundp 'emacs-major-version)) - (string-match "^[0-9]+" emacs-version)) - (setq emacs-major-version - (string-to-int (substring emacs-version - (match-beginning 0) (match-end 0))))) -(if (and (not (boundp 'emacs-minor-version)) - (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version)) - (setq emacs-minor-version - (string-to-int (substring emacs-version - (match-beginning 1) (match-end 1))))) - -;;; Define a function to make it easier to check which version we're -;;; running. - -(defun running-emacs-version-or-newer (major minor) - (or (> emacs-major-version major) - (and (= emacs-major-version major) - (>= emacs-minor-version minor)))) - -(cond ((and running-xemacs - (running-emacs-version-or-newer 19 6)) - ;; - ;; Code requiring XEmacs/Lucid Emacs version 19.6 or newer goes here - ;; - )) - -(cond ((>= emacs-major-version 19) - ;; - ;; Code for any vintage-19 emacs goes here - ;; - )) -(cond ((and (not running-xemacs) - (>= emacs-major-version 19)) - ;; - ;; Code specific to FSF Emacs 19 (not XEmacs/Lucid Emacs) goes here - ;; - )) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Changing the Modeline ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(cond ((< emacs-major-version 19) - ;; - ;; Code specific to emacs 18 goes here - ;; +;; Enable line numbers and column numbers. This is done in C code now +;; and is very fast. +(line-number-mode 1) +(column-number-mode 1) + +;; Rearrange the modeline so that everything is to the left of the +;; long list of minor modes, which is relatively unimportant but takes +;; up so much room that anything to the right is obliterated. + +(setq-default + modeline-format + (list + "" + (if (boundp 'modeline-multibyte-status) 'modeline-multibyte-status "") + (cons modeline-modified-extent 'modeline-modified) + (cons modeline-buffer-id-extent + (list (cons modeline-buffer-id-left-extent + (cons 15 (list + (list 'line-number-mode "L%l ") + (list 'column-number-mode "C%c ") + (cons -3 "%p")))) + (cons modeline-buffer-id-right-extent "%17b"))) + " " + 'global-mode-string + " %[(" + (cons modeline-minor-mode-extent + (list "" 'mode-name 'minor-mode-alist)) + (cons modeline-narrowed-extent "%n") + 'modeline-process + ")%]----" + "%-" )) ＠＠ -354,6 +796,8 ＠＠ ;; Customization of Specific Packages ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; ******************** ;;; Load gnuserv, which will allow you to connect to XEmacs sessions ;;; using `gnuclient'. ＠＠ -371,18 +815,13 ＠＠ (require 'dired) ;; compatible ange-ftp/efs initialization derived from code ;; from John Turner <turner(a)lanl.gov&gt; -;; As of 19.15, efs is bundled instead of ange-ftp. -;; NB: doesn't handle 20.0 properly, efs didn't appear until 20.1. ;; ;; The environment variable EMAIL_ADDRESS is used as the password ;; for access to anonymous ftp sites, if it is set. If not, one is ;; constructed using the environment variables USER and DOMAINNAME ;; (e.g. turner(a)lanl.gov), if set. -(if (and running-xemacs - (or (> emacs-major-version 20) - (and (= emacs-major-version 20) (>= emacs-minor-version 1)) - (and (= emacs-major-version 19) (>= emacs-minor-version 15)))) +(condition-case nil (progn (message "Loading and configuring bundled packages... efs") (require 'efs-auto) ＠＠ -395,7 +834,7 ＠＠ (setq efs-generate-anonymous-password (concat (getenv "USER")"＠"(getenv "DOMAINNAME"))))) (setq efs-auto-save 1)) - (progn + (error (message "Loading and configuring bundled packages... ange-ftp") (require 'ange-ftp) (if (getenv "USER") ＠＠ -407,23 +846,22 ＠＠ (setq ange-ftp-generate-anonymous-password (concat (getenv "USER")"＠"(getenv "DOMAINNAME"))))) (setq ange-ftp-auto-save 1) - ) - ) + )) + ;;; ******************** -;;; Load the default-dir.el package which installs fancy handling -;;; of the initial contents in the minibuffer when reading -;;; file names. - -(if (and running-xemacs - (or (and (= emacs-major-version 20) (>= emacs-minor-version 1)) - (and (= emacs-major-version 19) (>= emacs-minor-version 15)))) - (require 'default-dir)) +;;; Load the default-dir.el package which installs fancy handling of +;;; the initial contents in the minibuffer when reading file names. +(condition-case nil + (require 'default-dir) + (error nil)) + + ;;; ******************** ;;; Load the auto-save.el package, which lets you put all of your autosave ;;; files in one place, instead of scattering them around the file system. -;;; +;;; #### comment about how this can speed up a slow nfs. (setq auto-save-directory (expand-file-name "~/autosave/") auto-save-directory-fallback auto-save-directory auto-save-hash-p nil ＠＠ -437,17 +875,7 ＠＠ ;; auto-save-directory exists (creating it if not) when it's loaded. (require 'auto-save) -;; This adds additional extensions which indicate files normally -;; handled by cc-mode. -(setq auto-mode-alist - (append '(("\\.C$" . c++-mode) - ("\\.cc$" . c++-mode) - ("\\.hh$" . c++-mode) - ("\\.c$" . c-mode) - ("\\.h$" . c-mode)) - auto-mode-alist)) - ;;; ******************** ;;; cc-mode (the mode you're in when editing C, C++, and Objective C files) ＠＠ -486,9 +914,13 ＠＠ ;;; ******************** -;;; Edebug is a source-level debugger for emacs-lisp programs. -;;; -(define-key emacs-lisp-mode-map "\C-xx" 'edebug-defun) +;;; Filladapt is a syntax-highlighting package. When it is enabled it +;;; makes filling (e.g. using M-q) much much smarter about paragraphs +;;; that are indented and/or are set off with semicolons, dashes, etc. + +(require 'filladapt) +(setq-default filladapt-mode t) +(add-hook 'c-mode-hook 'turn-off-filladapt-mode) ;;; ******************** ＠＠ -549,22 +981,6 ＠＠ ;;; ******************** -;;; fast-lock is a package which speeds up the highlighting of files -;;; by saving information about a font-locked buffer to a file and -;;; loading that information when the file is loaded again. This -;;; requires a little extra disk space be used. -;;; -;;; Normally fast-lock puts the cache file (the filename appended with -;;; .flc) in the same directory as the file it caches. You can -;;; specify an alternate directory to use by setting the variable -;;; fast-lock-cache-directories. - -;; Let's use lazy-lock instead. -;;(add-hook 'font-lock-mode-hook 'turn-on-fast-lock) -;;(setq fast-lock-cache-directories '("/foo/bar/baz")) - - -;;; ******************** ;;; lazy-lock is a package which speeds up the highlighting of files ;;; by doing it "on-the-fly" -- only the visible portion of the ;;; buffer is fontified. The results may not always be quite as ＠＠ -590,16 +1006,16 ＠＠ ;;; (cond (running-xemacs (require 'func-menu) - (define-key global-map 'f8 'function-menu) + (global-set-key 'kp-multiply 'function-menu) (add-hook 'find-file-hooks 'fume-add-menubar-entry) - (define-key global-map "\C-cl" 'fume-list-functions) - (define-key global-map "\C-cg" 'fume-prompt-function-goto) + (global-set-key "\C-cl" 'fume-list-functions) + (global-set-key "\C-cg" 'fume-prompt-function-goto) ;; The Hyperbole information manager package uses (shift button2) and ;; (shift button3) to provide context-sensitive mouse keys. If you ;; use this next binding, it will conflict with Hyperbole's setup. ;; Choose another mouse key if you use Hyperbole. - (define-key global-map '(shift button3) 'mouse-function-menu) + (global-set-key '(shift button3) 'mouse-function-menu) ;; For descriptions of the following user-customizable variables, ;; type C-h v <variable> ＠＠ -641,6 +1057,7 ＠＠ (autoload 'resize-minibuffer-mode "rsz-minibuf" nil t) (resize-minibuffer-mode) (setq resize-minibuffer-window-exactly nil) + ;;; ******************** ;;; W3 is a browser for the World Wide Web, and takes advantage of the very