From:	CSBVAX::CSBVAX::MRGATE::"SMTP::VX.LCS.MIT.EDU::JOSH"  7-DEC-1988 13:33
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VMS mods to Gnu Emacs


Received: from VX.LCS.MIT.EDU by AI.AI.MIT.EDU via Chaosnet; 7 DEC 88  12:39:12 EST
Received: by VX.LCS.MIT.EDU with sendmail-4.12/4.8 id <AA29204@VX.LCS.MIT.EDU>; Wed, 7 Dec 88 12:37:58 est
Date: Wed, 7 Dec 88 12:37:58 est
From: Joshua Marantz <josh@VX.LCS.MIT.EDU>
To: EVERHART%ARISIA.decnet@ge-crd.arpa
In-Reply-To: EVERHART%ARISIA.decnet@ge-crd.arpa's message of 2 Dec 88 19:25 EST
Subject: VMS mods to Gnu Emacs

I think that enough people were interested in VMS X11 Gnu Emacs to justify
distribution.  I have given Nelson Beebe full sources to be distributed
from CC.UTAH.EDU.  He may make some announcement about that.  The unix
context diffs, and a vms-compatible version of direx.el are listed below.

Make sure you run vms-pp on the unix 18.52 sources before you patch them
with my diffs.  To patch in unix, set up a subdirectory "vmssrc" with
the vms-pp'd unix sources in them, and type "patch -p <vmsemacs.dif".
On VMS, you may be able to apply these patches by hand.  It would be
easier to obtain the full sources (which are a 120k compressed tar file)
from utah.  Other sources (such as the Vax SIG tape) may distribute it
as well.  If anyone wants the full sources mailed directly to them, let
me know.

Direx.el is Thomas Lord's (tbl@k.cs.cmu.edu) package for directory editing
without using a subprocess.  It has much of the functionality of dired.
I hacked it to work on VMS.  I suspect that it should still work on Unix,
but I haven't tried it.  I admit I didn't do a very complete job on this,
but it works for all the functions that I use.

Good luck.

----------------------Paste into file vmsemacs.dif------------------------
*** unixsrc/dired.c	Tue Dec  6 14:53:13 1988
--- vmssrc/dired.c	Mon Nov 28 15:23:35 1988
***************
*** 363,368 ****
--- 363,387 ----
  		Fcons (make_number (time & 0177777), Qnil));
  }
  
+ /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88-------- */
+ DEFUN ("time-string", Ftime_string, Stime_string, 1, 1, 0,
+   "Convert TIME-LIST, which is a list of the high-order and\n\
+ low-order bytes of a Unix time value, to a string.")
+   (time_list)
+     Lisp_Object time_list;
+ {
+     Lisp_Object s;
+     long time_val, high, low;
+     char *temp;
+ 
+     s = Fcar (time_list);           CHECK_NUMBER (s, 3);  high = XFASTINT (s);
+     s = Fcar (Fcdr (time_list));    CHECK_NUMBER (s, 3);  low =  XFASTINT (s);
+     time_val = (high << 16) | low;
+     temp = (char *) ctime (&time_val);
+     return (build_string (temp));
+ }
+ 
+ 
  DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
    "Return a list of attributes of file FILENAME.\n\
  Value is nil if specified file cannot be opened.\n\
***************
*** 445,450 ****
--- 464,472 ----
  #endif /* VMS */
    defsubr (&Sfile_name_all_completions);
    defsubr (&Sfile_attributes);
+ 
+ /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88-------- */
+   defsubr (&Stime_string);
  
  #ifdef VMS
    Qcompletion_ignore_case = intern ("completion-ignore-case");
*** unixsrc/keyboard.c	Tue Dec  6 14:53:18 1988
--- vmssrc/keyboard.c	Mon Nov 28 15:23:35 1988
***************
*** 992,997 ****
--- 992,1005 ----
       int *addr;
  {
  #ifdef VMS
+ 
+ /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88-------- */
+ #ifdef HAVE_X_WINDOWS
+     extern int XTclear_screen ();
+     if (clear_screen_hook == XTclear_screen)
+         XTprocess_window_events ();
+ #endif
+ 
    /* On VMS, we always have something in the buffer
       if any input is available.  */
    /*** It might be simpler to make interrupt_input 1 on VMS ***/
*** unixsrc/sysdep.c	Tue Dec  6 14:53:25 1988
--- vmssrc/sysdep.c	Mon Nov 28 15:23:36 1988
***************
*** 19,24 ****
--- 19,36 ----
  and this notice must be preserved on all copies.  */
  
  
+ /*
+ This file has been heavily modified so that it can work under X11 and
+ VMS (using DECwindows).  All the changes conditionalize various things
+ between the terminal and DECwindows, using the preprocessor macro
+ VMS_X11.  Search for that and you will find all the changes.
+ 
+ 					Joshua Marantz
+ 					Viewlogic Systems, Inc.
+ 					(508) 480-0881
+ 					josh@vx.lcs.mit.edu
+ */
+ 
  #include <signal.h>
  #include <setjmp.h>
  
***************
*** 85,92 ****
  #include <rab.h>
  #endif
  #define	MAXIOSIZE ( 32 * PAGESIZE )	/* Don't I/O more than 32 blocks at a time */
- #endif /* VMS */
  
  #ifndef BSD4_1
  #ifdef BSD /* this is done this way to avoid defined(BSD) || defined (USG)
  	      because the vms compiler doesn't grok `defined' */
--- 97,128 ----
  #include <rab.h>
  #endif
  #define	MAXIOSIZE ( 32 * PAGESIZE )	/* Don't I/O more than 32 blocks at a time */
  
+ /* ---------------------Preprocessor black magic!!----------------------------
+    Define a macro that will perform some action if we are currently running
+    under X11 on VMS.  The critical thing is that the action must not be
+    compiled in unless Emacs is compiled for VMS/X windows, because other
+    VMS users may not be able to link against the DECwindows libraries.
+    On the other hand, just because you've compiled for X windows on VMS
+    doesn't mean you are running it that way on every invocation.  So if
+    we are compiling for X, we use a real if statement, leaving the else
+    clause free.  If we are not, then we do not even reference the action.
+                 -Joshua Marantz,
+ 		Viewlogic Systems Inc.
+ 		11/1/88
+ */
+ #ifdef HAVE_X_WINDOWS
+ extern int XTclear_screen ();
+ #define IF_VMS_X11(action) if (clear_screen_hook == XTclear_screen) action
+ #define IF_NOT_VMS_X11() if (clear_screen_hook != XTclear_screen)
+ #else
+ #define IF_VMS_X11(action) if (0)
+ #define IF_NOT_VMS_X11()
+ #endif
+ 
+ #else /* VMS */
+ #endif /* not VMS */
+ 
  #ifndef BSD4_1
  #ifdef BSD /* this is done this way to avoid defined(BSD) || defined (USG)
  	      because the vms compiler doesn't grok `defined' */
***************
*** 265,274 ****
      return;
  
  #ifdef VMS
!   end_kbd_input ();
!   SYS$QIOW (0, input_chan, IO$_READVBLK|IO$M_PURGE, input_iosb, 0, 0,
! 	    &buf, 0, 0, terminator_mask, 0, 0);
!   queue_kbd_input ();
  #else /* not VMS */
    ioctl (0, TIOCGETP, &buf);
    ioctl (0, TIOCSETP, &buf);
--- 301,313 ----
      return;
  
  #ifdef VMS
!   IF_VMS_X11 (XTdiscard_input ());
!   else {
!       end_kbd_input ();
!       SYS$QIOW (0, input_chan, IO$_READVBLK|IO$M_PURGE, input_iosb, 0, 0,
! 		&buf, 0, 0, terminator_mask, 0, 0);
!       queue_kbd_input ();
!   }
  #else /* not VMS */
    ioctl (0, TIOCGETP, &buf);
    ioctl (0, TIOCSETP, &buf);
***************
*** 299,306 ****
    else
      {
  #ifdef VMS
!       SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
! 		&sg.class, 12, 0, 0, 0, 0 );
  #else
        SETOSPEED (sg, B9600);
        ioctl (0, TIOCGETP, &sg);
--- 338,346 ----
    else
      {
  #ifdef VMS
! 	IF_NOT_VMS_X11 ()
! 	    SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
! 		      &sg.class, 12, 0, 0, 0, 0 );
  #else
        SETOSPEED (sg, B9600);
        ioctl (0, TIOCGETP, &sg);
***************
*** 509,514 ****
--- 549,555 ----
  #ifdef VMS
    unsigned long parent_id;
  
+   IF_VMS_X11 (return (-1));
    parent_id = getppid ();
    if (parent_id && parent_id != 0xffffffff)
      {
***************
*** 744,751 ****
      ((unsigned) 1 << (process_ef % 32));
    timer_eflist = ((unsigned) 1 << (input_ef % 32)) |
      ((unsigned) 1 << (timer_ef % 32));
!   SYS$QIOW (0, input_chan, IO$_SENSEMODE, &old_gtty, 0, 0,
! 	    &old_gtty.class, 12, 0, 0, 0, 0);
  #ifndef VMS4_4
    sys_access_reinit ();
  #endif
--- 785,794 ----
      ((unsigned) 1 << (process_ef % 32));
    timer_eflist = ((unsigned) 1 << (input_ef % 32)) |
      ((unsigned) 1 << (timer_ef % 32));
!   IF_VMS_X11 (XTinit_vms_input (input_ef));
!   else
!       SYS$QIOW (0, input_chan, IO$_SENSEMODE, &old_gtty, 0, 0,
! 		&old_gtty.class, 12, 0, 0, 0, 0);
  #ifndef VMS4_4
    sys_access_reinit ();
  #endif
***************
*** 811,818 ****
  #endif /* not HAVE_TERMIO */
  
  #ifdef VMS
!       SYS$QIOW (0, input_chan, IO$_SETMODE, &input_iosb, 0, 0,
! 		&sg.class, 12, 0, 0, 0, 0);
  #else
        ioctl (0, TIOCSETN, &sg);
  #endif /* not VMS */
--- 854,862 ----
  #endif /* not HAVE_TERMIO */
  
  #ifdef VMS
!       IF_NOT_VMS_X11 ()
! 	  SYS$QIOW (0, input_chan, IO$_SETMODE, &input_iosb, 0, 0,
! 		    &sg.class, 12, 0, 0, 0, 0);
  #else
        ioctl (0, TIOCSETN, &sg);
  #endif /* not VMS */
***************
*** 885,891 ****
        SYS$QIOW (0, input_chan, IO$_SETMODE|IO$M_OUTBAND, 0, 0, 0,
  		interrupt_signal, oob_chars, 0, 0, 0, 0);
  */
!       queue_kbd_input (0);
  #endif /* VMS */
      }
  #ifdef VMS  /* VMS sometimes has this symbol but lacks setvbuf.  */
--- 929,936 ----
        SYS$QIOW (0, input_chan, IO$_SETMODE|IO$M_OUTBAND, 0, 0, 0,
  		interrupt_signal, oob_chars, 0, 0, 0, 0);
  */
!       IF_NOT_VMS_X11 ()
! 	  queue_kbd_input (0);
  #endif /* VMS */
      }
  #ifdef VMS  /* VMS sometimes has this symbol but lacks setvbuf.  */
***************
*** 921,926 ****
--- 966,972 ----
    if (noninteractive)
      return 1;
  #ifdef VMS
+   IF_VMS_X11 (return (1));
    SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
  	    &sg.class, 12, 0, 0, 0, 0);
  #else
***************
*** 962,971 ****
  #else /* not TIOCGWNSIZ */
  #ifdef VMS
    TERMINAL sg;
!   SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
! 	    &sg.class, 12, 0, 0, 0, 0);
!   *widthp = sg.scr_wid;
!   *heightp = sg.scr_len;
  #else /* system doesn't know size */
    *widthp = 0;
    *heightp = 0;
--- 1008,1020 ----
  #else /* not TIOCGWNSIZ */
  #ifdef VMS
    TERMINAL sg;
!   IF_VMS_X11 (*widthp = *heightp = 0);
!   else {
!       SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
! 		&sg.class, 12, 0, 0, 0, 0);
!       *widthp = sg.scr_wid;
!       *heightp = sg.scr_len;
!   }
  #else /* system doesn't know size */
    *widthp = 0;
    *heightp = 0;
***************
*** 1019,1027 ****
      reset_sigio ();
  #endif /* BSD4_1 */
  #ifdef VMS
!   end_kbd_input ();
!   SYS$QIOW (0, input_chan, IO$_SETMODE, &input_iosb, 0, 0,
! 	    &old_gtty.class, 12, 0, 0, 0, 0);
  #else /* not VMS */
    while (ioctl (0, TCSETAW, &old_gtty) < 0 && errno == EINTR);
  #endif /* not VMS */
--- 1068,1078 ----
      reset_sigio ();
  #endif /* BSD4_1 */
  #ifdef VMS
!   IF_NOT_VMS_X11 () {
!       end_kbd_input ();
!       SYS$QIOW (0, input_chan, IO$_SETMODE, &input_iosb, 0, 0,
! 		&old_gtty.class, 12, 0, 0, 0, 0);
!   }
  #else /* not VMS */
    while (ioctl (0, TCSETAW, &old_gtty) < 0 && errno == EINTR);
  #endif /* not VMS */
***************
*** 1035,1052 ****
  
  /* Assigning an input channel is done at the start of Emacs execution.
     This is called each time Emacs is resumed, also, but does nothing
!    because input_chain is no longer zero.  */
  
  init_vms_input()
  {
    int status;
    
!   if (input_chan == 0)
!     {
!       status = SYS$ASSIGN (&input_dsc, &input_chan, 0, 0);
!       if (! (status & 1))
! 	LIB$STOP (status);
!     }
  }
  
  /* Deassigning the input channel is done before exiting.  */
--- 1086,1104 ----
  
  /* Assigning an input channel is done at the start of Emacs execution.
     This is called each time Emacs is resumed, also, but does nothing
!    because input_chan is no longer zero.  */
  
  init_vms_input()
  {
    int status;
    
!   if (input_chan == 0) {
!       IF_NOT_VMS_X11 () {
! 	  status = SYS$ASSIGN (&input_dsc, &input_chan, 0, 0);
! 	  if (! (status & 1))
! 	      LIB$STOP (status);
!       }
!   }
  }
  
  /* Deassigning the input channel is done before exiting.  */
***************
*** 1053,1059 ****
  
  stop_vms_input ()
  {
!   return SYS$DASSGN (input_chan);
  }
  
  short input_buffer;
--- 1105,1112 ----
  
  stop_vms_input ()
  {
!     IF_NOT_VMS_X11 ()
! 	return SYS$DASSGN (input_chan);
  }
  
  short input_buffer;
***************
*** 1115,1154 ****
  
  /* Wait until there is something in kbd_buffer.  */
  
! wait_for_kbd_input ()
! {
!   extern int have_process_input, process_exited;
  
!   /* If already something, avoid doing system calls.  */
!   if (detect_input_pending ())
!     {
!       return;
!     }
!   /* Clear a flag, and tell ast routine above to set it.  */
!   SYS$CLREF (input_ef);
!   waiting_for_ast = 1;
!   /* Check for timing error: ast happened while we were doing that.  */
!   if (!detect_input_pending ())
!     {
!       /* No timing error: wait for flag to be set.  */
!       SYS$WFLOR (input_ef, input_eflist);
!       if (!detect_input_pending ())
! 	/* Check for subprocess input availability */
! 	{
! 	  int dsp = have_process_input || process_exited;
  
! 	  if (have_process_input)
! 	    process_command_input ();
! 	  if (process_exited)
! 	    process_exit ();
! 	  if (dsp)
! 	    {
! 	      RedoModes++;
! 	      DoDsp (1);
  	    }
  	}
      }
-   waiting_for_ast = 0;
  }
  
  /* Get rid of any pending QIO, when we are about to suspend
--- 1168,1212 ----
  
  /* Wait until there is something in kbd_buffer.  */
  
! /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88--------
!    This routine was changed to use a while loop so that X11 window events,
!    such as exposure and resizing, would be handled better.  Under the old
!    method, which used an "if" instead of a "while", window events would
!    not be handled until the next keyboard event.
! */
! wait_for_kbd_input () {
!     extern int have_process_input, process_exited;
  
!     /* If already something, avoid doing system calls.  */
!     while (!detect_input_pending ()) {
  
! 	/* Clear a flag, and tell ast routine above to set it.  */
! 	SYS$CLREF (input_ef);
! 	waiting_for_ast = 1;
! 
! 	/* Check for timing error: ast happened while we were doing that.  */
! 	if (!detect_input_pending ()) {
! 	    /* No timing error: wait for flag to be set.  */
! 	    SYS$WFLOR (input_ef, input_eflist);
! 	    if (!detect_input_pending ()) {
! 
! 		/* Check for subprocess input availability */
! 		int dsp = have_process_input || process_exited;
! 
! 		if (have_process_input)
! 		    process_command_input ();
! 		if (process_exited)
! 		    process_exit ();
! 		if (dsp) {
! 		    RedoModes++;
! 		    DoDsp (1);
! 		}
! 
! 		IF_VMS_X11 (XTprocess_window_events ());
  	    }
  	}
+ 	waiting_for_ast = 0;
      }
  }
  
  /* Get rid of any pending QIO, when we are about to suspend
***************
*** 2737,2742 ****
--- 2795,2801 ----
    return pathname;
  }
  
+ #ifndef VMS5_0
  getppid ()
  {
    long item_code = JPI$_OWNER;
***************
*** 2751,2756 ****
--- 2810,2816 ----
      }
    return parent_id;
  }
+ #endif
  
  #ifdef getuid
  #undef getuid
*** unixsrc/x11fns.c	Tue Dec  6 14:53:28 1988
--- vmssrc/x11fns.c	Mon Nov 28 15:23:36 1988
***************
*** 40,46 ****
  #else
  #include <sys/time.h>
  #endif
! #include <fcntl.h>
  #include <setjmp.h>
  
  #ifdef HAVE_X_WINDOWS
--- 40,46 ----
  #else
  #include <sys/time.h>
  #endif
! /* #include <fcntl.h> --------Commented out 11/1/88, Joshua Marantz--------*/
  #include <setjmp.h>
  
  #ifdef HAVE_X_WINDOWS
*** unixsrc/x11term.c	Tue Dec  6 14:53:32 1988
--- vmssrc/x11term.c	Mon Nov 28 15:23:37 1988
***************
*** 21,27 ****
--- 21,53 ----
  /* Written by Yakim Martillo, mods and things by Robert Krawitz  */
  /* Redone for X11 by Robert French */
  /* Thanks to Mark Biggers for all of the Window Manager support */
+ /*
  
+ Heavily #ifdefd to support VAX/VMS.  A better X11 implementation would
+ have been portable between operating systems.  Unfortunately, the
+ original Unix implementation depends too much on Unix signals to
+ implement detection of Control-G interrupts and window events.  The
+ easiest way to get this to work under VMS was to use the DECwindows
+ asynchronous event notification support to hook into the existing AST
+ support for terminal I/O.  The same event flag is used, and it appears
+ to work well.  The cost is portability between X on different
+ operating systems.  The benefits on VMS, however, are many: The screen
+ refresh speed much greater than that in a terminal emulator window.
+ The Compose key functions as a Meta key.  And you can resize an Emacs
+ in progress, without having to suspend and resume.  Another difference
+ between VMS and Unix is that the DECwindows window manager supports
+ focus-based (click-to-type) keyboard management, and so the
+ solid/hollow cursor is based on focus notification instead of
+ enter/leave events.
+ 
+ Look for #ifdef/#ifndef VMS to spot all the differences.
+ 
+ 					Joshua Marantz
+ 					Viewlogic Systems, Inc.
+ 					(508) 480-0881
+ 					josh@vx.lcs.mit.edu
+ */
+ 
  /*
   *	$Source: /mit/emacs/src/RCS/11xterm.c,v $
   *	$Author: rfrench $
***************
*** 82,88 ****
  #include <sys/time.h>
  #endif
  
! #include <fcntl.h>
  #include <stdio.h>
  #include <ctype.h>
  #include <errno.h>
--- 108,114 ----
  #include <sys/time.h>
  #endif
  
! /* #include <fcntl.h> */
  #include <stdio.h>
  #include <ctype.h>
  #include <errno.h>
***************
*** 609,615 ****
--- 635,643 ----
  XTflash ()
  {
  	XGCValues gcv_temp;
+ #ifndef VMS
  	struct timeval to;
+ #endif
  	BLOCK_INPUT_DECLARE ();
  
  #ifdef XDEBUG
***************
*** 627,640 ****
  	  	 	screen_height*XXfonth+2*XXInternalBorder);
  	XFlush (XXdisplay);
  
  	UNBLOCK_INPUT ();
- 
  	to.tv_sec = 0;
  	to.tv_usec = 250000;
- 	
  	select(0, 0, 0, 0, &to);
  	
  	BLOCK_INPUT ();
  
  	XFillRectangle (XXdisplay, XXwindow, XXgc_temp, 0, 0,
  			screen_width*XXfontw+2*XXInternalBorder,
--- 655,672 ----
  	  	 	screen_height*XXfonth+2*XXInternalBorder);
  	XFlush (XXdisplay);
  
+ #ifdef VMS
+ 	/* this routine really should have better granularity so we can
+ 	   do .25 seconds just like the big boys from Unix can! */
+ 	input_wait_timeout (1);
+ #else
  	UNBLOCK_INPUT ();
  	to.tv_sec = 0;
  	to.tv_usec = 250000;
  	select(0, 0, 0, 0, &to);
  	
  	BLOCK_INPUT ();
+ #endif
  
  	XFillRectangle (XXdisplay, XXwindow, XXgc_temp, 0, 0,
  			screen_width*XXfontw+2*XXInternalBorder,
***************
*** 1039,1044 ****
--- 1071,1077 ----
  	}
  }
  	
+ #ifndef VMS
  /* Substitutes for standard read routine.  Under X not interested in individual
   * bytes but rather individual packets.
   */
***************
*** 1054,1059 ****
--- 1087,1093 ----
  
  	return (internal_socket_read (bufp, numchars));
  }
+ #endif /* not VMS */
  
  /*
   * Interpreting incoming keycodes. Should have table modifiable as needed
***************
*** 1211,1216 ****
--- 1245,1251 ----
  }
  #endif /* not sun */
  	
+ #ifndef VMS
  internal_socket_read(bufp, numchars)
  	register unsigned char *bufp;
  	register int numchars;
***************
*** 1399,1404 ****
--- 1434,1440 ----
    UNBLOCK_INPUT ();
    return count;
  }
+ #endif /* not VMS */
  
  /* Exit gracefully from gnuemacs, doing an autosave and giving a status.
   */
***************
*** 1416,1421 ****
--- 1452,1458 ----
  
  xfixscreen ()
  {
+ #ifndef VMS
  	BLOCK_INPUT_DECLARE ();
  
  	/* Yes, this is really what I mean -- Check to see if we've
***************
*** 1432,1437 ****
--- 1469,1475 ----
  		CursorToggle ();
  
  	UNBLOCK_INPUT ();
+ #endif
  }
  	
  
***************
*** 1538,1544 ****
--- 1576,1584 ----
  	update_begin_hook = XTupdate_begin;
  	update_end_hook = XTupdate_end;
  	set_terminal_window_hook = XTset_terminal_window;
+ #ifndef VMS
  	read_socket_hook = XTread_socket;
+ #endif
  	topos_hook = XTtopos;
  	reassert_line_highlight_hook = XTreassert_line_highlight;
  	scroll_region_ok = 1;	/* we'll scroll partial screens */
***************
*** 1575,1583 ****
--- 1615,1637 ----
  	XXicon_usebitmap = 0;
  	
  	temp_font = "fixed";
+ 
+ /* ------Joshua Marantz 11/1/88, argv[0] on VMS contains full pathname------*/
+ #ifdef VMS
  	progname = xargv[0];
+ 	if (ptr = rindex(progname, ']'))
+ 	  progname = ptr+1;
+ 	ptr = progname;
+ 	progname = xmalloc (strlen (ptr) + 1);
+ 	strcpy (progname, ptr);
+ 	if (ptr = rindex (progname, '.'))
+ 	    *ptr = 0;
+ #else
+ 	progname = xargv[0];
  	if (ptr = rindex(progname, '/'))
  	  progname = ptr+1;
+ #endif
+ 
  	XXpid = getpid ();
  	default_window = "=80x24+0+0";
  
***************
*** 2056,2061 ****
--- 2110,2131 ----
  }
  
  
+ #ifdef VMS
+ static void gethostname(buf, len)
+     char *buf;
+     int len;
+ {
+     char *s;
+     s = getenv ("SYS$NODE");
+     if (s == NULL)
+         buf[0] = '\0';
+     else {
+         strncpy (buf, s, len - 2);
+         buf[len - 1] = '\0';
+     } /* else */
+ } /* static void gethostname */
+ #endif
+ 
  /* ------------------------------------------------------------
   */
  static char  hostname[100];
***************
*** 2356,2367 ****
  
      XSelectInput(XXdisplay, XXwindow, KeyPressMask |
  		 ExposureMask | ButtonPressMask | ButtonReleaseMask |
! 		 EnterWindowMask | LeaveWindowMask |
  		 StructureNotifyMask);
  
      XMapWindow (XXdisplay, XXwindow);
      XFlush (XXdisplay);
  }
  
  #endif /* HAVE_X_WINDOWS */
  
--- 2426,2614 ----
  
      XSelectInput(XXdisplay, XXwindow, KeyPressMask |
  		 ExposureMask | ButtonPressMask | ButtonReleaseMask |
! 		 EnterWindowMask | LeaveWindowMask | FocusChangeMask |
  		 StructureNotifyMask);
  
      XMapWindow (XXdisplay, XXwindow);
      XFlush (XXdisplay);
  }
+ 
+ #ifdef VMS
+ /* The VMS routines in SYSDEP.C use event flags to determine if the user
+    hit the key during a timer run.  Fortunately, DECwindows supplies AST
+    notification capability to X events, so we can set the AST that way. */
+ extern int waiting_for_ast;
+ static int input_ast(input_ef)
+     int input_ef;
+ {
+     XEvent event;
+     int nbytes, i;
+     char mapping_buf[20];
+     KeySym keysym;
+     XComposeStatus status;
+ 
+     if (waiting_for_ast)
+ 	SYS$SETEF (input_ef);
+     waiting_for_ast = 0;
+ 
+     while (XCheckMaskEvent (XXdisplay, KeyPressMask | ButtonPressMask |
+ 			    ButtonReleaseMask, &event))
+     {
+ 	switch (event.type) {
+ 	  case KeyPress:
+ 	    /* Someday this will be unnecessary as we will
+ 	       be able to use XRebindKeysym so XLookupString
+ 	       will have always give us the string we want. */
+ 	    nbytes = 1;
+ 	    keysym = XKeycodeToKeysym (XXdisplay, event.xkey.keycode, 0);
+ 
+ #define CTRL(c) (c - 64)
+ #define META(c) (c + 128)
+ #define STUFF(c) *mapping_buf = c; break;
+ 
+ 	    switch (keysym) {
+ 		case XK_Left:    STUFF (CTRL ('B'));
+ 		case XK_Right:   STUFF (CTRL ('F'));
+ 		case XK_Up:      STUFF (CTRL ('P'));
+ 		case XK_Down:    STUFF (CTRL ('N'));
+ 		case XK_Prior:   STUFF (META ('V'));
+ 		case XK_Next:    STUFF (CTRL ('V'));
+ 		case XK_Insert:  STUFF (CTRL ('Y'));
+ 		case DXK_Remove: STUFF (CTRL ('W'));
+ 		case XK_Find:    STUFF (CTRL ('S'));
+ 		case XK_Select:  STUFF (CTRL ('@'));
+ 		case XK_Help:    STUFF (CTRL ('H'));
+ 		case XK_Execute: STUFF (CTRL ('\\'));
+ 		default:
+ 		    if (IsFunctionKey (keysym) || IsMiscFunctionKey (keysym)) {
+ 			strcpy (mapping_buf, "[");
+ 			strcat (mapping_buf, stringFuncVal (keysym));
+ 			strcat (mapping_buf, "~");
+ 			nbytes = strlen (mapping_buf);
+ 		    }
+ 		    else
+ 			nbytes = XLookupString (&event, mapping_buf, 20,
+ 						&keysym, &status);
+ 	    } /* switch */
+ 	    if (nbytes > 0) {
+ 		if (event.xkey.state & Mod1Mask)
+ 		    *mapping_buf |= METABIT;
+ 		for (i = 0; i < nbytes; i++)
+ 		    kbd_buffer_store_char (mapping_buf[i]);
+ 	    }
+ 	    break;
+ 
+ 	  case ButtonPress:
+ 	  case ButtonRelease:
+ 	    kbd_buffer_store_char ('X' & 037);
+ 	    kbd_buffer_store_char ('@' & 037);
+ 	    if (XXm_queue_num == XMOUSEBUFSIZE)
+ 	      break;
+ 	    XXm_queue[XXm_queue_in] = (XEvent *) malloc (sizeof(XEvent));
+ 	    *XXm_queue[XXm_queue_in] = event;
+ 	    XXm_queue_num++;
+ 	    XXm_queue_in = (XXm_queue_in + 1) % XMOUSEBUFSIZE;
+ 	    break;
+ 	}
+     }
+ }
+ 
+ XTinit_vms_input(input_ef)
+     unsigned long input_ef;
+ {
+     XSelectAsyncInput (XXdisplay, XXwindow,
+                        KeyPressMask | ExposureMask | ButtonPressMask |
+                        ButtonReleaseMask | EnterWindowMask |
+ 		       FocusChangeMask |
+                        LeaveWindowMask | StructureNotifyMask,
+                        input_ast, input_ef);
+ } /* XTinit_vms_input */
+ 
+ XTdiscard_input () {
+ }
+ 
+ static void solid_cursor() {
+     CursorToggle ();
+     CursorOutline = 0;
+     CursorToggle ();
+ }
+ 
+ static void hollow_cursor() {
+     CursorToggle ();
+     CursorOutline = 1;
+     CursorToggle ();
+ }
+ 
+ XTprocess_window_events() {
+     int rows, cols;
+     XEvent event;
+     static int focus = 0;
+ 
+     while (XCheckMaskEvent (XXdisplay, ExposureMask | EnterWindowMask |
+ 			    LeaveWindowMask | StructureNotifyMask |
+ 			    FocusChangeMask, &event))
+     {
+ 	event.type &= 0177;		/* Mask out XSendEvent indication */
+ 
+ 	switch (event.type) {
+ 	  case NoExpose:
+ 	  default:                                                       break;
+ 	  case MappingNotify:     XRefreshKeyboardMapping(&event);       break;
+ 	  case MapNotify:         WindowMapped = 1;                      break;
+ 	  case UnmapNotify:       WindowMapped = 0;                      break;
+ 	  case EnterNotify:       if (!focus) solid_cursor ();           break;
+ 	  case LeaveNotify:       if (!focus) hollow_cursor ();          break;
+ 	  case FocusIn:           solid_cursor ();  focus = 1;           break;
+ 	  case FocusOut:          hollow_cursor (); focus = 1;           break;
+ 
+ 	  case ConfigureNotify:
+ 	    if (abs (pixelheight - event.xconfigure.height) < XXfonth &&
+ 		abs (pixelwidth  - event.xconfigure.width) <  XXfontw)
+ 		break;
+ 
+ 	    configure_pending = 1;
+ 
+ 	    rows = (event.xconfigure.height - 2 * XXInternalBorder) / XXfonth;
+ 	    cols = (event.xconfigure.width  - 2 * XXInternalBorder) / XXfontw;
+ 	    pixelwidth = cols * XXfontw + 2 * XXInternalBorder;
+ 	    pixelheight = rows * XXfonth + 2 * XXInternalBorder;
+ 	    break;
+ 
+ 	  case Expose:
+ 	    if (configure_pending) {
+ 	      int width, height;
+ 	      if (event.xexpose.count)
+ 		break;
+ 	      /* This is absolutely, amazingly gross.
+ 	       * However, without it, emacs will core
+ 	       * dump if the window gets too small.  And
+ 	       * uwm is too brain-damaged to handle
+ 	       * large minimum size windows. */
+ 	      width = (pixelwidth-2*XXInternalBorder)/XXfontw;
+ 	      height = (pixelheight-2*XXInternalBorder)/XXfonth;
+ 	      if (width > 11 && height > 4)
+ 		      change_screen_size (height, width, 0);
+ 	      dumprectangle (0,0,pixelheight,pixelwidth);
+ 	      configure_pending = 0;
+ 	      break;
+ 	    }
+ 	    dumprectangle (event.xexpose.y-XXInternalBorder,
+ 			   event.xexpose.x-XXInternalBorder,
+ 			   event.xexpose.height,
+ 			   event.xexpose.width);
+ 	    break;
+ 
+ 	  case GraphicsExpose:
+ 	    dumprectangle (event.xgraphicsexpose.y-XXInternalBorder,
+ 			   event.xgraphicsexpose.x-XXInternalBorder,
+ 			   event.xgraphicsexpose.height,
+ 			   event.xgraphicsexpose.width);
+ 	    break;
+ 	}
+     }
+ }
+ 
+ #endif /* VMS */
  
  #endif /* HAVE_X_WINDOWS */
  
*** unixsrc/x11term.h	Tue Dec  6 18:30:18 1988
--- vmssrc/x11term.h	Tue Dec  6 18:34:56 1988
***************
*** 3,9 ****
--- 3,11 ----
  #include <X11/keysym.h>
  #include <X11/cursorfont.h>
  #include <X11/Xutil.h>
+ #ifndef VMS /* --- This is not needed - Joshua Marantz, 11/1/88 --- */
  #include <X11/X10.h>
+ #endif
  
  #define XMOUSEBUFSIZE 64
  
*** unixsrc/s-vms.h	Tue Dec  6 18:30:25 1988
--- vmssrc/s-vms.h	Mon Nov 28 15:23:40 1988
***************
*** 140,146 ****
     shared library, define this and remake xmakefile and fileio.c. This allows
     us to ship a guaranteed executable image. */
  
! /* #define LINK_CRTL_SHARE */
  
  /* Define this if you want to read the file SYS$SYSTEM:SYSUAF.DAT for user
     information.  If you do use this, you must either make SYSUAF.DAT world 
--- 140,146 ----
     shared library, define this and remake xmakefile and fileio.c. This allows
     us to ship a guaranteed executable image. */
  
! #define LINK_CRTL_SHARE
  
  /* Define this if you want to read the file SYS$SYSTEM:SYSUAF.DAT for user
     information.  If you do use this, you must either make SYSUAF.DAT world 
***************
*** 223,229 ****
  { 0, 50, 75, 110, 134, 150, 300, 600, 1200, 1800, \
    2000, 2400, 3600, 4800, 7200, 9600, 19200 }
  
! #define PURESIZE 132000
  
  /* Stdio FILE type has extra indirect on VMS, so must alter this macro.  */
  
--- 223,232 ----
  { 0, 50, 75, 110, 134, 150, 300, 600, 1200, 1800, \
    2000, 2400, 3600, 4800, 7200, 9600, 19200 }
  
! /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88-------- */
! #define PURESIZE 136000     /* For x windows */
! /* #define PURESIZE 132000 */
! 
  
  /* Stdio FILE type has extra indirect on VMS, so must alter this macro.  */
  
*** unixsrc/config.h	Tue Dec  6 18:30:08 1988
--- vmssrc/config.h	Mon Nov 28 15:23:39 1988
***************
*** 24,30 ****
     See the file ../etc/MACHINES for a list of systems and
     the names of the s- files to use for them.
     See s-template.h for documentation on writing s- files.  */
! #include "s-bsd4-2.h"
  
  /* Include here a m- file that describes the machine and system you use.
     See the file ../etc/MACHINES for a list of machines and
--- 24,30 ----
     See the file ../etc/MACHINES for a list of systems and
     the names of the s- files to use for them.
     See s-template.h for documentation on writing s- files.  */
! #include "s-vms4-4.h"
  
  /* Include here a m- file that describes the machine and system you use.
     See the file ../etc/MACHINES for a list of machines and
***************
*** 31,37 ****
     the names of the m- files to use for them.
     See m-template.h for info on what m- files should define.
     */
! #include "m-sun3.h"
  
  /* Load in the conversion definitions if this system
     needs them and the source file being compiled has not
--- 31,37 ----
     the names of the m- files to use for them.
     See m-template.h for info on what m- files should define.
     */
! #include "m-vax.h"
  
  /* Load in the conversion definitions if this system
     needs them and the source file being compiled has not
***************
*** 57,63 ****
     This appears to work on some machines that support X
     and not on others.  */
  
! #define HAVE_X_MENU
  
  /* Define `subprocesses' should be defined if you want to
     have code for asynchronous subprocesses
--- 57,63 ----
     This appears to work on some machines that support X
     and not on others.  */
  
! /* #define HAVE_X_MENU */
  
  /* Define `subprocesses' should be defined if you want to
     have code for asynchronous subprocesses

*** unixsrc/temacs.opt	Tue Dec  6 20:30:00 1988
--- vmssrc/temacs.opt	Mon Nov 28 15:24:14 1988
***************
*** 46,51 ****
--- 46,53 ----
  tparam.obj,-
  lastfile.obj,-
  alloca.obj,-
+ x11term.obj,-
+ x11fns.obj,-
  malloc.obj
  collect=non_saved_data,-
  stdin,-
***************
*** 56,59 ****
  sys_errlist,-
  sys_nerr,-
  environ
! sys$library:vaxcrtl/library
--- 58,62 ----
  sys_errlist,-
  sys_nerr,-
  environ
! sys$share:decw$xlibshr/share
! sys$library:vaxcrtl/lib
*** unixsrc/compile.com	Tue Dec  6 20:30:06 1988
--- vmssrc/compile.com	Tue Dec  6 20:28:11 1988
***************
*** 60,62 ****
--- 60,64 ----
  $    @recomp lastfile.c
  $    @recomp malloc.c
  $    @recomp alloca.c
+ $    @recomp x11term.c
+ $    @recomp x11fns.c

----------------------End of vmsemacs.dif---------------------------------
-----------------------paste into lisp/direx.el--------------------------------
; From: tbl@k.cs.cmu.edu (Thomas Lord)
; Newsgroups: comp.emacs
; Subject: a dired replacement for GNU
; Date: 24 Mar 87 23:41:00 GMT
; Organization: Carnegie-Mellon University, CS/RI
; Posting-Front-End: GNU Emacs 18.36.5 of Sat Feb 14 1987 on k.cs.cmu.edu (berkeley-unix)
; 
; 
; <I came in late...what's all this about a ...line eater?>
; 
; Below is Direx.el, my replacement for dired.  Since Direx works without
; running ls it should be considerably faster on most systems.  There is a
; trade off, however.  By default, direx uses a short style directory
; listing.  That is, each file is listed by name only (no size,
; protection, owner etc).  To get that extra information you must
; explicitly call direx-fake-ls (bound to "l" by default).  
; 
; To invoke direx on some directory type M-x direx.  You will be
; prompted for the directory name.
; 
; 
; Direx mode is a superset of dired mode. In addition to the usual
; commands the following exist:
; 
; direx-alternate-file : kill the current buffer and find the file
; pointed to.  If that file is in fact a directory, then direx it.
; This is normally bound to "j".  It is very usefull for bopping up and
; down directory trees.
; 
; direx-expand-subdirectory : add the contents of a subdirectory to a
; direx buffer.  Bound to "s".
; 
; direx-fake-ls : use the long listing format.  bound to "l"
; 
; There may still be bugs, particularly with features that don't get
; much exercize locally (such as direx-clean-directory).  Please mail me
; reports of any you find.
; 
; If you get to like direx (and I hope you will) you may wish to make
; the following bindings:
; 
; (global-set-key "\C-x\C-f" 'direx-file)
; (global-set-key "\C-x\C-v" 'direx-alternate-file)
; (global-set-key "\C-x4f"   'direx-file-other-window)
; 
; 
; Have fun!
; 
; Thomas Lord
;  lord@andrew.cmu.edu			<----- prefered
;  tbl@k.cs.cmu.edu
; 
; ------ cut here and store in direx.el --------

;; DIREX commands for Emacs
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;
;;
;; TODO


;; add sorting : involves changes to direx-show-directory-fast,
;;               direx-add-entry, direx-move-to-file-name 
;;               direx-before-file-name, direx-file-name,
;;               direx-expand-subdirectory, and direx-fake-ls but
;;               should be very straight-forward 
;; add dates to direx-fake-ls :
;;               involves addition of a lisp call to ctime in the 
;;               gnu-emacs c source 
;;
;; add mode changing stuff : very easy.  maybe *i*'ll do it.  
;; add better support for expanding subdirectories in situ...like
;;               maybe getting rid of expandes subdirectories 
;;
;; -------Made VMS-portable by Joshua Marantz, Viewlogic Systems Inc, 11/1/88
;;  This module depends on the new time-string function, written in C, in
;;  dired.c:
;;
;;DEFUN ("time-string", Ftime_string, Stime_string, 1, 1, 0,
;;  "Convert TIME-LIST, which is a list of the high-order and\n\
;;low-order bytes of a Unix time value, to a string.")
;;  (time_list)
;;    Lisp_Object time_list;
;;{
;;    Lisp_Object s;
;;    long time_val, high, low;
;;    char *temp;
;;
;;    s = Fcar (time_list);          CHECK_NUMBER (s, 3);  high = XFASTINT (s);
;;    s = Fcar (Fcdr (time_list));   CHECK_NUMBER (s, 3);  low =  XFASTINT (s);
;;    time_val = (high << 16) | low;
;;    temp = (char *) ctime (&time_val);
;;    return (build_string (temp));
;;}
;;
;; Someone should really write a uid-to-uname function for VMS, and should
;; write a lisp function to shorten the result of time-string a la unix
;; "ls -l".  Essentially, it drops the year if it is this year, and drops
;; the hour/minute/second info for other years.


(defun vms-p () (string= system-type 'vax-vms))

(defun name-around-point ()
  "Return the whitespace delimitted text under the point."
  (save-excursion
    (buffer-substring (progn (re-search-backward "[ \t^]")
			     (forward-char 1)
			     (point))
		      (progn (re-search-forward  "[ \t\n%]")
			     (forward-char -1)
			     (point)))))



(defun repeat (n exp)
  "N times, eval EXP.  Repeat once if N is nil."
  (let ( (count (or n 1)) )
    (while (> count 0)
      (eval exp)
      (setq count (1- count)))))


(defvar direx-use-long-directory nil
  "*If this is non-nil, direx mode will always use a long directory format.")

(defvar direx-indicate-directories nil
  "*If non-nil, short direx listings have % after directory names. (Slower)")


(defun direx-show-directory-fast (directory &optional prefix)
  "Insert at the point a brief listing of DIRECTORY."
  (let* ( (buffer-read-only nil)
	  (prefix (or prefix ""))
	  (expanded-name (directory-file-name (expand-file-name directory)))
	  (attributes    (file-attributes expanded-name)) )
    (cond ( (stringp (car attributes))
	    (direx-show-directory-fast (car attributes)) )
	  ( (not (car attributes))
	    (error "%s is not a directory!" directory) )
	  ( t
	    (or (bolp)
		(insert "\n"))
	    (let ( (start (point))
		   (file-list (directory-files directory nil nil)) )
	      (while file-list
		(let ( (fname (car file-list)) )
		  (insert "  "
			  prefix
			  fname
			  (if (and direx-indicate-directories
				   (file-directory-p fname))
			      "%"
			    "")
			  "\n")
		  (setq file-list (cdr file-list))))
	      (if (or ls-done direx-use-long-directory)
		  (let ( (ls-done nil) )
		    (direx-fake-ls start (1- (point))))))
	    (delete-blank-lines) ))))


(defun direx-add-entry (directory name)
  "  Add an entry for file name if it is in a subdirectory of the
  defualt directory. This will fail if directory is made up of links.
  Right now, we are so lazy that we do not bother to sort."
    (if (= 0 (string-match (expand-file-name default-directory)
		      (expand-file-name directory)))
      (let ( (buffer-read-only nil)
	     (relative-directory
	      (substring directory (match-end 0) (length directory)))
	     (ls-was-done ls-done)
	     (ls-done nil)
	     (start (point)) )
	(if (not (= (point) (point-min)))
	    (insert "\n"))
	(insert "  " relative-directory name)
	(if ls-was-done
	    (direx-fake-ls start (point)))
	(direx-before-file-name))))



(defun direx-move-to-file-name ()
  "Move to the file name field in a direx buffer."
  (end-of-line))

(defun direx-before-file-name ()
  "Move the point before a file name."
  (direx-move-to-file-name)
  (skip-chars-backward "^ \n\t"))

(defun direx-file-name ()
  "Return the name of the file on this line."
  (save-excursion
    (direx-move-to-file-name)
    (let ( (name (name-around-point)) )
      (if (string= name "")
	  (error "No file on this line.")
	name))))

(defun direx-expand-subdirectory ()
  "Insert the subdirectory for the current file in a direx buffer."
  (interactive)
  (direx-move-to-file-name)
  (let ( (buffer-read-only nil)
	 (name  (direx-file-name))
	  (start (point)) )
    (end-of-line 1)
    (direx-show-directory-fast
     (file-name-as-directory
      (concat default-directory name)))
    (goto-char start)
    (direx-next-line)))

(if (vms-p)
    (progn
      (defun vms-remove-colon (name)
	(if (string= ":" (substring name -1))
	    (substring name 0 -1)
	  name))

      (defun vms-remove-000000 (name)
	(let ((start-zeros (string-match "000000\\." name)))
	  (if start-zeros
	      (concat (substring name 0 start-zeros)
		      (substring name (+ start-zeros 7)))
	    name)))

      (defun vms-eval-logical (name)
	(let* ((upname  (upcase name))
	       (nocolon (vms-remove-colon upname))
	       (translation (getenv nocolon)))
	  (if translation
	      (vms-eval-logical translation)
	    (vms-remove-000000 upname))))))

(defun direx (directory)
  "Make a buffer for directory and direx in it."
  (interactive "DDirectory: ")
  (let* ( (ex-name (file-name-as-directory (expand-file-name directory)))
	  (dir     (if (vms-p) (vms-eval-logical ex-name) ex-name))
	  (buffer  (get-buffer-create dir)) )
    (switch-to-buffer buffer)
    (let ( (buffer-read-only nil) )
      (erase-buffer)
      (setq buffer-read-only t)
      (setq default-directory dir)
      (make-local-variable 'ls-done)
      (setq ls-done nil)
      (direx-show-directory-fast default-directory)
      (goto-char (point-min))
      (direx-before-file-name)
      (direx-mode dir)
      (set-buffer-modified-p nil))
    (setq buffer-read-only t)))


(defun direx-file (file)
  "Find the file FILE unless it is a directory.  If it is a directory,
   direx it."
  (interactive "FFile: ")
  (let ( (attributes (file-attributes file)) )
    (cond ( (eq (car attributes) t)
	    (direx (expand-file-name file)) )
	  ( (car attributes)
	    (direx-file (car attributes)) )
	  ( t
	    (find-file file) ))))
      
(defun direx-alternate-file (file)
  "Visit the file FILE unless it is a directory.  If it is a directory,
   direx it. Kills the current buffer."
  (interactive "FFile: ")
  (let ( (attributes (file-attributes file))
	 (full-name (expand-file-name file)) )
    (cond ( (eq (car attributes) t)
	    (kill-buffer (current-buffer)) 
	    (direx full-name) )
	  ( (car attributes)
	    (direx-alternate-file (car attributes)) )
	  ( t (find-alternate-file file) ))))



(if (vms-p)
    (defun uid-to-uname (uid) uid)
  (progn
    (defvar uid-cache '(("-1"."paranoid"))
      "  A cache for argument-value pairs from uid-to-uname.")

    (defun password-buffer ()
      "Return the buffer *passwd* which hopefully contains the passwd file."
      (or (get-buffer "*passwd*")
	  (save-excursion
	    (switch-to-buffer (get-buffer-create "*passwd*"))
	    (insert-file "/etc/passwd")
	    (current-buffer))))


    (defun uid-to-uname (uid)
      "  Convert a user id to a user name.  We assume we can lay claim to a
buffer named *passwd*."
      (or (cdr (assoc uid uid-cache))
	  (let ( (pwbuff (password-buffer)) )
	    (save-excursion
	      (switch-to-buffer pwbuff)
	      (goto-char (point-min))
	      (let* ((uid-string (concat ":" uid ":"))
		     (pwstring (format "^\\([^:\n]*\\):[^:\n]*%s" uid-string)))
		(catch 'no-such-uid
		  (while (not (looking-at pwstring))
		    (if (not (search-forward uid-string nil t))
			(throw 'no-such-uid uid))
		    (beginning-of-line))
		  (let ((uname
			 (buffer-substring (match-beginning 1) (match-end 1))))
		    (setq uid-cache (cons (cons uid uname) uid-cache))
		    (bury-buffer (current-buffer))
		    uname)))))))))

(defun direx-fake-ls (&optional start end)
  "  The current buffer should consist of lines of file names.
   direx-fake-ls makes it look like they were put there by ls -l.
   Optional parameters START and END bound the action of direx-fake-ls"
  (interactive)
  (if ls-done
      nil
    (save-excursion
      (let ( (buffer-read-only nil)
	     (bottom (or end (point-max)))
	     (top (or start (point-min))) )
	(goto-char (1- bottom))
	(while (>= (point) top)
	  (let ( (attributes
		  (or (file-attributes (direx-file-name))
		      '(() -1 -1 () () () () "???" "-barf!-"))) )
	    (beginning-of-line)
	    (if (= (point) top) (setq top (point-max)))
	    (direx-before-file-name)
	    (let ( (access (nth 8 attributes))
		   (links  (concat (nth 1 attributes)))
		   (uid    (concat (nth 2 attributes)))
		   (date   (nth 5 attributes))
		   (size   (concat (nth 7 attributes))) )
	      (insert access)
	      (indent-to-column (- 20 (length links)))
	      (if (vms-p)
		  (progn (insert (time-string date)) (backward-delete-char 1))
		(insert links " " (uid-to-uname uid)))
	      (indent-to-column (- 50 (length size)))
	      (insert size "  ")
	      (direx-previous-line))))
	(setq ls-done t)))
    (direx-before-file-name)))

(defun direx-next-line (&optional count)
  "Move to the file name on the next line.  With ARG, move that many lines."
  (interactive "p")
  (let ( (n (or count 1)) )
    (forward-line n)
    (direx-before-file-name)))

(defun direx-previous-line (&optional count)
  "Move to the file name on the previous line. 
   With ARG, move that many lines."
  (interactive "p")
  (let ( (n (or count 1)) )
    (direx-next-line (- n))))

(defun direx-set-deletion-field (value)
  "Put the char VALUE in the deletion field of the current line.
   Signal an error if there is no file on this line.
   Do nothing if the file on this line is a directory."
  (let* ( (name (direx-file-name))
	  (buffer-read-only nil)
	  (attributes (file-attributes name)) )
    (or (eq (car attributes) t)
      (progn
	(beginning-of-line 1)
	(delete-char 1)
	(insert value)
	(direx-before-file-name)))))


(defun direx-flag-file-deleted (&optional count)
  "Mark a file for deletion."
  (interactive "p")
  (repeat count
	  '(progn
	     (direx-set-deletion-field "D")
	     (direx-next-line))))

(defun direx-unflag (&optional count)
  "Unmark a bunch of files."
  (interactive "p")
  (repeat count
	  '(progn
	     (direx-set-deletion-field " ")
	     (direx-next-line))))

(defun direx-backup-unflag (&optional count)
  "Unmark a bunch of files moving backwards."
  (interactive "p")
  (repeat count
	  '(progn
	     (direx-previous-line)
	     (direx-set-deletion-field " "))))

(defun direx-file-marked-p ()
  "Return t if the current line has a deletion mark."
  (save-excursion
    (beginning-of-line 1)
    (looking-at "D ")))

(defun direx-revert (&optional arg noconfirm)
  "Revert a direx buffer."
  (interactive)
  (let ( (buffer-read-only nil) )
    (erase-buffer)
    (direx-show-directory-fast default-directory)
    (beginning-of-buffer)
    (direx-before-file-name)))


(defun direx-file-other-window (file)
  "Direx FILE in another window."
  (interactive "FFile:")
  (let ( (expanded-name (expand-file-name file)) )
    (other-window 1)
    (direx-file expanded-name)))


(defun direx-view-file (file)
  "Find FILE in view mode.  If FILE is a directory, direx it instead."
  (interactive "fFile: ")
  (let ( (attributes (file-attributes file)) )
    (cond ( (eq (car attributes) t)
	    (direx (expand-file-name file)) )
	  ( (car attributes)
	    (direx-view-file (car-attributes)) )
	  ( t
	    (view-file file) ))))


(defun direx-find-this ()
  "Direx interaction for direx-file."
  (interactive)
  (direx-file (direx-file-name)))

(defun direx-alternate-this ()
  "Direx interaction for direx-alternate-file."
  (interactive)
  (direx-alternate-file (direx-file-name)))

(defun direx-view-this ()
  "Direx interaction for direx-view-file."
  (interactive)
  (direx-view-file (direx-file-name)))

(defun direx-this-other-window ()
  "Direx interaction for direx-file-other-window."
  (interactive)
  (direx-file-other-window (direx-file-name)))

(defun direx-rename-file (to-file)
  "Rename this file to TO-FILE."
  (interactive "FRename to: ")
  (setq to-file (expand-file-name to-file))
  (rename-file (expand-file-name (direx-file-name)) to-file)
  (let ((buffer-read-only nil))
    (beginning-of-line)
    (delete-region (point) (progn (forward-line 1) (point)))
    (end-of-line 0)
    (setq to-file (expand-file-name to-file))
    (direx-add-entry (file-name-directory to-file)
		     (file-name-nondirectory to-file))))

  
(defun direx-do-deletions ()
  "In direx, delete the files flagged for deletion."
  (interactive)
  (let (delete-list answer)
    (save-excursion
     (goto-char 1)
     (while (re-search-forward "^D" nil t)
       (setq delete-list
	     (cons (cons (direx-file-name) (1- (point)))
		   delete-list))))
    (if (null delete-list)
	(message "(No deletions requested)")
      (save-window-excursion
       (switch-to-buffer " *Deletions*")
       (erase-buffer)
       (setq fill-column (- (window-width) 10))
       (let ((l (reverse delete-list)))
         ;; Files should be in forward order for this loop.
	 (while l
	   (if (> (current-column) (- (window-width) 21))
	       (insert ?\n)
	     (or (bobp)
		 (indent-to (* (/ (+ (current-column) 19) 20) 20) 1)))
	   (insert (car (car l)))
	   (setq l (cdr l))))
       (goto-char (point-min))
       (setq answer (yes-or-no-p "Delete these files? ")))
      (if answer
	  (let ((l delete-list)
		failures)
	    ;; Files better be in reverse order for this loop!
	    ;; That way as changes are made in the buffer
	    ;; they do not shift the lines still to be changed.
	    (while l
	      (goto-char (cdr (car l)))
	      (let ((buffer-read-only nil))
		(condition-case ()
		    (progn (delete-file (concat default-directory
						(car (car l))))
			   (message (concat default-directory (car (car l))))
			   (delete-region (progn (beginning-of-line) (point))
					  (progn (forward-line 1) (point))))
		  (error (delete-char 1)
			 (insert " ")
			 (setq failures (cons (car (car l)) failures)))))
	      (setq l (cdr l)))
	    (if failures
		(message "Deletions failed: %s"
			 (prin1-to-string failures))
	      (set-buffer-modified-p nil))
	    (direx-before-file-name))))))


(defun direx-copy-file (to-file)
  "Copy this file to TO-FILE."
  (interactive "FCopy to: ")
  (copy-file (direx-file-name) to-file)
  (setq to-file (expand-file-name to-file))
  (end-of-line)
  (direx-add-entry (file-name-directory to-file)
		   (file-name-nondirectory to-file)))
  

(defun direx-flag-auto-save-files ()
  "Flag for deletion files whose names suggest they are auto save files."
  (interactive)
  (save-excursion
   (let ((buffer-read-only nil))
     (goto-char (point-min))
     (while (not (eobp))
       (and (not (eolp))
	    (if (fboundp 'auto-save-file-name-p)
		(let ((fn (direx-file-name)))
		  (if fn (auto-save-file-name-p fn)))
	      (if (direx-before-filename)
		  (looking-at "#")))
	    (direx-set-deletion-field "D"))
       (forward-line 1)))))


(defun direx-flag-backup-files ()
  "Flag all backup files (names ending with ~) for deletion."
  (interactive)
  (save-excursion
   (let ((buffer-read-only nil))
     (goto-char (point-min))
     (while (not (eobp))
       (and (not (eolp))
	    (if (fboundp 'backup-file-name-p)
		(let ((fn (direx-file-name)))
		  (if fn (backup-file-name-p fn)))
	      (end-of-line)
	      (forward-char -1)
	      (looking-at "~"))
	    (direx-set-deletion-field "D"))
       (forward-line 1)))))


(defconst direx-kept-versions 2
  "*When cleaning directory, number of versions to keep.")

(defun direx-clean-directory (keep)
  "  Flag numerical backups for Deletion.
  Spares dired-kept-versions latest versions, and kept-old-versions oldest.
  Positive numeric arg overrides dired-kept-versions;
  negative numeric arg overrides kept-old-versions with minus the arg."
  (interactive "P")
  (setq keep (if keep (prefix-numeric-value keep) direx-kept-versions))
  (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
	(late-retention (if (<= keep 0) direx-kept-versions keep))
	(file-version-assoc-list ()))
    ;; Look at each file.
    ;; If the file has numeric backup versions,
    ;; put on file-version-assoc-list an element of the form
    ;; (FILENAME . VERSION-NUMBER-LIST)
    (direx-map-direx-file-lines 'direx-collect-file-versions)
    ;; Sort each VERSION-NUMBER-LIST,
    ;; and remove the versions not to be deleted.
    (let ((fval file-version-assoc-list))
      (while fval
	(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
	       (v-count (length sorted-v-list)))
	  (if (> v-count (+ early-retention late-retention))
	      (rplacd (nthcdr early-retention sorted-v-list)
		      (nthcdr (- v-count late-retention)
			      sorted-v-list)))
	  (rplacd (car fval)
		  (cdr sorted-v-list)))
	(setq fval (cdr fval)))) 
    ;; Look at each file.  If it is a numeric backup file,
    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
    (direx-map-direx-file-lines 'direx-trample-file-versions)))



(defun direx-collect-file-versions (ignore fn)
  "If it looks like fn has versions, we make a list of the versions.
We may want to flag some for deletion."
    (let* ((base-versions
	    (concat (file-name-nondirectory fn) ".~"))
	   (bv-length (length base-versions))
	   (possibilities (file-name-all-completions
			   base-versions
			   (file-name-directory fn)))
	   (versions (mapcar 'backup-extract-version possibilities)))
      (if versions
	  (setq file-version-assoc-list (cons (cons fn versions)
					      file-version-assoc-list)))))

(defun direx-trample-file-versions (ignore fn)
  (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
	 base-version-list)
    (and start-vn
	 (setq base-version-list	; there was a base version to which 
	       (assoc (substring fn 0 start-vn)	; this looks like a 
		      file-version-assoc-list))	; subversion
	 (not (memq (string-to-int (substring fn (+ 2 start-vn)))
		    base-version-list))	; this one doesn't make the cut
	 (direx-set-deletion-field "D"))))



(defun direx-map-direx-file-lines (fn)
  "perform fn with point at the end of each non-directory line:
arguments are the short and long filename"
  (save-excursion
    (let (filename longfilename (buffer-read-only nil))
      (goto-char (point-min))
      (while (not (eobp))
	(save-excursion
	  (and (not (looking-at "  d"))
	       (not (eolp))
	       (setq filename (direx-file-name)
		     longfilename (expand-file-name (direx-file-name)))
	       (progn (end-of-line)
		      (funcall fn filename longfilename))))
	(forward-line 1)))))



(defun direx-summary ()
  "Give the luser a summary of direx commands."
  (interactive)
  (message
   (substitute-command-keys
    "\\[direx-flag-file-deleted] delete, \\[direx-unflag] undelete, \\[direx-do-deletions] execute, \\[direx-find-this] find, \\[direx-alternate-this] jump")))



(defvar direx-mode-map nil "Local keymap for direx-mode buffers.")
(if direx-mode-map
    nil
  (setq direx-mode-map (make-keymap))
  (suppress-keymap direx-mode-map)
  (define-key direx-mode-map " "  'direx-next-line)
  (define-key direx-mode-map "#" 'direx-flag-auto-save-files)
  (define-key direx-mode-map "." 'direx-clean-directory)
  (define-key direx-mode-map "?" 'direx-summary)
  (define-key direx-mode-map "\C-?" 'direx-backup-unflag)
  (define-key direx-mode-map "\C-d" 'direx-flag-file-deleted)
  (define-key direx-mode-map "\C-n" 'direx-next-line)
  (define-key direx-mode-map "\C-p" 'direx-previous-line)
  (define-key direx-mode-map "c" 'direx-copy-file)
  (define-key direx-mode-map "d" 'direx-flag-file-deleted)
  (define-key direx-mode-map "e" 'direx-find-this)
  (define-key direx-mode-map "f" 'direx-find-this)
  (define-key direx-mode-map "g" 'revert-buffer)
  (define-key direx-mode-map "h" 'describe-mode)
  (define-key direx-mode-map "j" 'direx-alternate-this)
  (define-key direx-mode-map "l" 'direx-fake-ls)
  (define-key direx-mode-map "n" 'direx-next-line)
  (define-key direx-mode-map "o" 'direx-this-other-window)
  (define-key direx-mode-map "p" 'direx-previous-line)
  (define-key direx-mode-map "r" 'direx-rename-file)
  (define-key direx-mode-map "s" 'direx-expand-subdirectory)
  (define-key direx-mode-map "u" 'direx-unflag)
  (define-key direx-mode-map "v" 'direx-view-this)
  (define-key direx-mode-map "x" 'direx-do-deletions)
  (define-key direx-mode-map "~" 'direx-flag-backup-files))

;; Direx mode is suitable only for specially formatted data.
(put 'direx-mode 'mode-class 'special)

(defun direx-mode (dirname)
  "Mode for \"editing\" directory listings.
In direx, you are \"editing\" a list of the files in a directory.
You can move using the usual cursor motion commands.
Letters no longer insert themselves.
Instead, type d to flag a file for Deletion.
Type u to Unflag a file (remove its D flag).
  Type Rubout to back up one line and unflag.
Type x to eXecute the deletions requested.
Type l to get a more informative directory listing.
Type f to Find the current line's file
  (or Direx it, if it is a directory).
Type o to find file or direx directory in Other window.
Type # to flag temporary files (names beginning with #) for Deletion.
Type ~ to flag backup files (names ending with ~) for Deletion.
Type . to flag numerical backups for Deletion.
  (Spares direx-kept-versions or its numeric argument.)
Type r to rename a file.
Type c to copy a file.
Type v to view a file in View mode, returning to Direx when done.
Type g to read the directory again.  This discards all deletion-flags.
Type j to direx-find this file in a buffer replacing the current buffer.
Type s to expand a subdirectory in place.
Type l to get a long directory listing for the files in the current buffer.
Space and Rubout can be used to move down and up by lines.
\\{direx-mode-map}"
  (kill-all-local-variables)    
  (make-local-variable 'revert-buffer-function)
  (setq revert-buffer-function 'direx-revert)
  (setq major-mode 'direx-mode)
  (setq mode-name "Direx")
  (make-local-variable 'ls-done)
  (setq default-directory dirname)
  (setq mode-line-buffer-identification '("Direx: %17b"))
  (setq case-fold-search (vms-p))
  (setq buffer-read-only t)
  (use-local-map direx-mode-map)
  (run-hooks 'direx-mode-hook))
-------------------------end of lisp/direx.el---------------------------

