;;; -*- Mode:LISP; Package:ZWEI; Base:8; Readtable:ZL; Patch-File:T -*-


;;; Modified version of two-windows stuff, takes two windows
;;; (structures, not sheets) and makes them share the area
;;; originally occupied by the first of the two, except that
;;; this version makes two side-by-side vertical windows
;;; rather than one on top of the other.

(DEFUN TWO-WINDOWS (ZWEI-WINDOW-1 ZWEI-WINDOW-2)
  (REDISPLAY ZWEI-WINDOW-1 ':NONE)
  (LET ((W1 (WINDOW-SHEET ZWEI-WINDOW-1))
	(W2 (WINDOW-SHEET ZWEI-WINDOW-2))
	(FRAME (WINDOW-FRAME ZWEI-WINDOW-1)))
    (MULTIPLE-VALUE-BIND (LEFT TOP RIGHT BOTTOM)
	(SEND FRAME ':INSIDE-EDGES-WITHOUT-MODE-LINE-WINDOW)
      (TV:PRESERVE-SUBSTITUTE-STATUS (SEND W1 ':SUPERIOR)
	(TV:DELAYING-SCREEN-MANAGEMENT
	  (SEND W1 ':DEEXPOSE)
	  (SEND W2 ':DEEXPOSE)
	  (LET ((width (TRUNCATE (- right left) 2)))
	    (SEND W1 ':SET-EDGES LEFT TOP (+ width left) bottom)
	    (SEND W2 ':SET-EDGES (+ width left) TOP RIGHT BOTTOM)
	  (SEND W1 ':SET-LABEL NIL)
	  (SEND W2 ':SET-LABEL NIL)
	  (SEND W1 ':EXPOSE NIL ':CLEAN)		;Make sure they are both there
	  (SEND W2 ':EXPOSE NIL ':CLEAN)))))
    (SEND FRAME ':UPDATE-LABELS)))

;;;Handy zmacs extensions and fixes to existing features

(DEFCOM COM-KILL-OR-SAVE-BUFFERS "Put up a choice window various buffer operations." ()
  (LET ((BUFFER-ALIST
	  (DO ((BUFFER-LIST *ZMACS-BUFFER-LIST* (CDR BUFFER-LIST))
	       (RET NIL) (TEM)
	       (BUFFER) (FILE-ID))
	      ((NULL BUFFER-LIST) RET)
	    (SETQ BUFFER (CAR BUFFER-LIST))
	    (SETQ TEM (STRING-APPEND "  " (BUFFER-NAME BUFFER))
		  FILE-ID (BUFFER-FILE-ID BUFFER))
	    (SETF (CHAR TEM 0)
		  (COND ((EQ FILE-ID T)
			 #/+)
			((BUFFER-READ-ONLY-P BUFFER)
			 #/)
			((BUFFER-MODIFIED-P BUFFER)
			 #/*)
			(T
			 #/SP)))
	    (LET ((BASIC-CHOICES (IF (BUFFER-NEEDS-SAVING-P BUFFER)
				     '((:SAVE T) :KILL :NOT-MODIFIED)
				   '(:SAVE :KILL :NOT-MODIFIED))))
	      (PUSH (LIST BUFFER TEM
			  (IF (AND (BUFFER-PATHNAME BUFFER)
				   (call-editing-type-function *major-mode* 'lisp-syntax-p nil)
				   ;(EQ (GET (SEND BUFFER ':MAJOR-MODE) 'EDITING-TYPE) ':LISP)
				   )
			      (APPEND BASIC-CHOICES '(:COMPILE))
			    BASIC-CHOICES))
		    RET))))
	CHOICES EXIT-REASON)
    (SETQ BUFFER-ALIST
	  (SORT BUFFER-ALIST (LAMBDA (X Y &AUX STR1 STR2 CH1 CH2)
			       (IF (CHAR= (SETQ CH1 (CHAR (SETQ STR1 (CADR X)) 0))
					  (SETQ CH2 (CHAR (SETQ STR2 (CADR Y)) 0)))
				   (STRING-LESSP STR1 STR2)
				 (< (CASE CH1
				      (#/* 0)
				      (#/+ 1)
				      (#/SP 2)
				      (#/ 3))
				    (CASE CH2
				      (#/* 0)
				      (#/+ 1)
				      (#/SP 2)
				      (#/ 3)))))))
    (if ;;(= *numeric-arg* 16.)			;Was CONTROL-U CONTROL-U typed?
	(= *numeric-arg* 4.)			;use this line if you'd prefer simply CONTROL-U
	(mapcar #'(lambda (entry)		;If so, brings up the menu with all
		    (setf (third entry)		;buffers marked to be killed.
			  (substitute '(:kill t) ':kill (third entry))))
		buffer-alist))
    (SETF (VALUES CHOICES EXIT-REASON)
	  (TV:MULTIPLE-CHOOSE "  Buffer" BUFFER-ALIST
			      '((:SAVE "Save" NIL (:NOT-MODIFIED) NIL NIL)
				(:KILL "Kill" NIL (:NOT-MODIFIED) NIL NIL)
				(:NOT-MODIFIED "UnMod"
					       NIL (:SAVE :KILL) NIL NIL)
				(:COMPILE "Compile" NIL NIL NIL NIL))
			      `(:point ,(floor (// (tv:sheet-width *window*) 2))
				       ,(floor (// (tv:sheet-height *window*) 2)))
			      (min (length buffer-alist)
				   (floor (// (tv:sheet-height *window*)        	;gotta be a better way to say "number
					      (tv:sheet-line-height *window*))))))	;of lines displayable on *window*"
    (IF EXIT-REASON
	NIL
      ;; Make sure the current buffer gets done last
      (LET ((ELEM (ASSQ *INTERVAL* CHOICES)))
	(AND ELEM (SETQ CHOICES (NCONC (DELQ ELEM CHOICES) (NCONS ELEM)))))
      (DOLIST (CHOICE CHOICES)
	(LET ((BUFFER (CAR CHOICE)))
	  (IF (MEMQ ':SAVE (CDR CHOICE))
	      (SAVE-BUFFER BUFFER))
	  (IF (MEMQ ':COMPILE (CDR CHOICE))
	      (COMPILE-FILE (BUFFER-PATHNAME BUFFER)
			    :SET-DEFAULT-PATHNAME NIL
			    :PACKAGE (BUFFER-PACKAGE BUFFER)))
	  (IF (MEMQ ':NOT-MODIFIED (CDR CHOICE))
	      (SETF (BUFFER-TICK BUFFER) (TICK)))
	  (IF (MEMQ ':KILL (CDR CHOICE))
	      (KILL-BUFFER BUFFER T))))
      (FORMAT *QUERY-IO* "~&Done.")))
  DIS-NONE)


;;;Moved to LISPM.INIT
;;;(defmacro with-fdefine-warnings-inhibited ((&body body))
;;;  `(let ((inhibit-fdefine-warnings t))
;;;     ,body))

(catch-error
  (load "dj:smh;isearch.qfasl"))

(defmacro install-command-and-advertise (command char comtab announcement)
  ;; Install and notify.
  `(progn
     (zwei:command-store ,command ,char ,comtab)
     (format query-io ,announcement)))

(DEFUN DEFAULT-LIST-ONE-FILE (FILE &OPTIONAL (STREAM *STANDARD-OUTPUT*) &AUX PATHNAME)
  (COND ((NULL (SETQ PATHNAME (CAR FILE)))
	 (COND ((GET FILE :DISK-SPACE-DESCRIPTION)
		(SEND STREAM :LINE-OUT (GET FILE :DISK-SPACE-DESCRIPTION)))
	       ((GET FILE :PHYSICAL-VOLUME-FREE-BLOCKS)
		(DO ((FREE (GET FILE :PHYSICAL-VOLUME-FREE-BLOCKS) (CDR FREE))
		     (FLAG T NIL))
		    ((NULL FREE) (SEND STREAM :TYO #\NEWLINE))
		 (FORMAT STREAM "~A #~A=~D" (IF FLAG "Free:" ",") (CAAR FREE) (CDAR FREE))))
	       (T
		(SEND STREAM :TYO #\NEWLINE))))
	((TYPEP STREAM 'INTERVAL-STREAM)
	 (LET ((STRING (CREATE-LINE 'ART-STRING 128. NIL)))
	   (DEFAULT-LIST-ONE-FILE FILE STRING)
	   (SEND STREAM :LINE-OUT STRING)))
	((OR (NULL STREAM) (STRINGP STREAM))
	 (LET ((STRING
		 (OR STREAM (MAKE-ARRAY 128. :TYPE 'ART-STRING :LEADER-LENGTH 1))))
	   (SETF (FILL-POINTER STRING) 0)
	   (ARRAY-INITIALIZE STRING #\SP 0 (ARRAY-LENGTH STRING))
	   (VECTOR-PUSH (IF (GET FILE :DELETED) #\D #\SP) STRING)
	   (VECTOR-PUSH #\SP STRING)
	   (STRING-NCONC STRING (OR (GET FILE :PHYSICAL-VOLUME) ""))
	   (SETF (FILL-POINTER STRING) (1+ (MAX 5 (FILL-POINTER STRING))))
	   (STRING-NCONC STRING (SEND PATHNAME :STRING-FOR-DIRED))
	   (VECTOR-PUSH #\SP STRING)
	   (LET ((LINK-TO (GET FILE :LINK-TO)))
	     (IF LINK-TO
		 (PROGN (STRING-NCONC STRING "=> " LINK-TO " ")
			(SETF (FILL-POINTER STRING)
			      (MAX 56. (FILL-POINTER STRING))))
	       (progn
	       (LET ((LENGTH (GET FILE :LENGTH-IN-BLOCKS)))
		 (SETF (FILL-POINTER STRING)
		       (MAX 39. (FILL-POINTER STRING)))
		 (COND ((NULL LENGTH)
			(STRING-NCONC STRING "     "))
		       ((> LENGTH 999.)
			(SETF (FILL-POINTER STRING)
			      (NUMBER-INTO-ARRAY STRING LENGTH 10.
						 (FILL-POINTER STRING) 4))
			(VECTOR-PUSH #\SP STRING))
		       (T
			(SETF (FILL-POINTER STRING)
			      (MAX 40. (FILL-POINTER STRING)))
			(SETF (FILL-POINTER STRING)
			      (NUMBER-INTO-ARRAY STRING LENGTH 10.
						 (FILL-POINTER STRING) 3))
			(VECTOR-PUSH #\SP STRING))))
	       (LET ((LENGTH (GET FILE :LENGTH-IN-BYTES)))
		 (IF (GET FILE :DIRECTORY)
		     (STRING-NCONC STRING "DIRECTORY")
		   (WHEN LENGTH
		     (SETF (FILL-POINTER STRING)
			   (NUMBER-INTO-ARRAY STRING LENGTH 10.
					      (FILL-POINTER STRING) 6))
		     (VECTOR-PUSH #\( STRING)
		     (SETF (FILL-POINTER STRING)
			   (NUMBER-INTO-ARRAY STRING (GET FILE :BYTE-SIZE) 10.
					      (FILL-POINTER STRING)))
		     (VECTOR-PUSH #\) STRING))))
	       (SETF (FILL-POINTER STRING)
		     (MAX 55. (FILL-POINTER STRING)))
	       (VECTOR-PUSH (COND ((GET FILE :OFFLINE) #\O)
				  ((GET FILE :NOT-BACKED-UP) #\!)
				  (T #\SP))
			    STRING))))
	   (VECTOR-PUSH (IF (GET FILE :DONT-DELETE) #\@ #\SP) STRING)
	   (VECTOR-PUSH (IF (GET FILE :DONT-SUPERSEDE) #\# #\SP) STRING)
	   (VECTOR-PUSH (IF (GET FILE :DONT-REAP) #\$ #\SP) STRING)
	   (TIME-INTO-ARRAY STRING (GET FILE :CREATION-DATE))
	   (LET* ((DATE-LAST-EXPUNGE (GET FILE :DATE-LAST-EXPUNGE))
		  (REFERENCE-DATE (OR DATE-LAST-EXPUNGE (GET FILE :REFERENCE-DATE))))
	     (WHEN (NOT (MEMQ REFERENCE-DATE '(NIL :NIL)))  ;AVOID LOSSAGE CAUSED BY
			;UNMENTIONABLE THINGS HAPPENING DURING RESTORE-MAGTAPE
	       (STRING-NCONC STRING (IF DATE-LAST-EXPUNGE " X=" " ("))
	       (TIME-INTO-ARRAY STRING REFERENCE-DATE NIL)
	       (OR DATE-LAST-EXPUNGE (STRING-NCONC STRING ")"))))
	   (LET ((AUTHOR (GET FILE :AUTHOR)))
	     (WHEN (AND AUTHOR (NOT (EQUAL AUTHOR (SEND PATHNAME :DIRECTORY))))
	       (SETF (FILL-POINTER STRING)
		     (MAX 88. (FILL-POINTER STRING)))
	       (STRING-NCONC STRING AUTHOR)))
	   (LET ((READER (GET FILE :READER)))
	     (WHEN (AND READER (NOT (EQUAL READER (SEND PATHNAME :DIRECTORY))))
	       (SETF (FILL-POINTER STRING)
		     (MAX 98. (FILL-POINTER STRING)))
	       (STRING-NCONC STRING READER)))
	   STRING))
	(T (FORMAT STREAM "~C ~3A "
		   (IF (GET FILE :DELETED) #\D #\SP)
		   (OR (GET FILE :PHYSICAL-VOLUME) ""))
	   (IF (OPERATION-HANDLED-P STREAM :ITEM)
	       (SEND STREAM :ITEM 'FILE PATHNAME "~A" (SEND PATHNAME :STRING-FOR-DIRED))
	     (SEND STREAM :STRING-OUT (SEND PATHNAME :STRING-FOR-DIRED)))
	   (FORMAT STREAM "~20T")
	   (LET ((LINK-TO (GET FILE :LINK-TO)))
	     (IF LINK-TO
		 (FORMAT STREAM "=> ~A ~40T" LINK-TO)
	       (progn
	       (LET ((LENGTH (GET FILE :LENGTH-IN-BLOCKS)))
		 (LET ((*STANDARD-OUTPUT* STREAM))
		   (FORMAT:TAB 39.))
		 (COND ((NULL LENGTH)
			(LET ((*STANDARD-OUTPUT* STREAM))
			  (FORMAT:TAB 44.)))
		       ((> LENGTH 999.)
			(FORMAT STREAM "~4D " LENGTH))
		       (T
			(LET ((*STANDARD-OUTPUT* STREAM))
			  (FORMAT:TAB 40.))
			(FORMAT STREAM "~3D " LENGTH))))
	       (LET ((LENGTH (GET FILE :LENGTH-IN-BYTES)))
		 (IF (GET FILE :DIRECTORY)
		     (PRINC "  DIRECTORY" STREAM)
		   (AND LENGTH
			(FORMAT STREAM "~6D(~D)" LENGTH (GET FILE :BYTE-SIZE)))))
	       (FORMAT STREAM "~55T")
	       (SEND STREAM :TYO
		     (COND ((GET FILE :OFFLINE) #\O)
			   ((GET FILE :NOT-BACKED-UP) #\!)
			   (T #\SP)))))
	   (SEND STREAM :TYO (IF (GET FILE :DONT-DELETE) #\@ #\SP))
	   (SEND STREAM :TYO (IF (GET FILE :DONT-SUPERSEDE) #\# #\SP))
	   (SEND STREAM :TYO (IF (GET FILE :DONT-REAP) #\$ #\SP))
	   (LET ((CREATION-DATE (GET FILE :CREATION-DATE)))
	     (IF CREATION-DATE
		 (MULTIPLE-VALUE-BIND (SECONDS MINUTES HOURS DAY MONTH YEAR)
		     (TIME:DECODE-UNIVERSAL-TIME CREATION-DATE)
		   (FORMAT STREAM "~2,'0D//~2,'0D//~2,'0D ~2,'0D:~2,'0D:~2,'0D"
			   MONTH DAY (MOD YEAR 100.) HOURS MINUTES SECONDS))
		 (FORMAT STREAM "~17@T")))
	   (LET* ((DATE-LAST-EXPUNGE (GET FILE :DATE-LAST-EXPUNGE))
		  (REFERENCE-DATE (OR DATE-LAST-EXPUNGE (GET FILE :REFERENCE-DATE))))
	     (AND (NOT (MEMQ REFERENCE-DATE '(NIL :NIL)))  ;AVOID LOSSAGE CAUSED BY
			;UNMENTIONABLE THINGS HAPPENING DURING RESTORE-MAGTAPE
		  (MULTIPLE-VALUE-BIND (NIL NIL NIL DAY MONTH YEAR)
		      (TIME:DECODE-UNIVERSAL-TIME REFERENCE-DATE)
		    (PRINC (IF DATE-LAST-EXPUNGE " X=" " (")
			   STREAM)
		    (FORMAT STREAM "~2,'0D//~2,'0D//~2,'0D" MONTH DAY (MOD YEAR 100.))
		    (OR DATE-LAST-EXPUNGE (PRINC ")" STREAM))))) 
	   (LET ((AUTHOR (GET FILE :AUTHOR)))
	     (AND AUTHOR (NOT (EQUAL AUTHOR (SEND PATHNAME :DIRECTORY)))
		  (FORMAT STREAM "~88T~A" AUTHOR)))
	   (LET ((READER (GET FILE :READER)))
	     (AND READER (NOT (EQUAL READER (SEND PATHNAME :DIRECTORY)))
		  (FORMAT STREAM "~98T~A" READER)))
	   (SEND STREAM :TYO #\NEWLINE)))))

(DEFCOM COM-STRING-SEARCH-SELECT-BUFFERS-AS-TAG-TABLE
	"Select the buffers whose names contain a specified string as a tag table.
This causes commands such as Tags Search, Tags Query Replace, and
Tags Compile Changed Sections to look through all buffers you specify." ()
  (let (the-string)
    (SELECT-FILE-LIST-AS-TAG-TABLE
      (mapcar #'buffer-pathname
	      (specify-list-of-buffers
	        :only-non-special-buffers t
	        :only-file-buffers t
	        :substring (setq the-string
		  	         (typein-line-readline "Include buffers whose names contain the string: "))
  	        :query-string nil))
      (TYPEIN-LINE-READLINE-WITH-DEFAULT (string-append "Buffers with " the-string
							" in their names")	;disambiguating string in
						;front to aid in specifying
						;the tag table later on...
					 "Name for this tag table:")))
  DIS-NONE)



;;;;Problem: Fails to clear kill history before pushing marked thing -- previously
;;;;killed text appears at point!
;(DEFCOM COM-MOUSE-MOVE-THING-TO-CURSOR
;  "Takes sexp pointed at by the mouse and zaps a copy of it to current cursor location." ()
;  (COM-SET-POP-MARK)
;  (let ((*mouse-x* system:mouse-x)
;	(*mouse-y* system:mouse-y))
;    (COM-MOUSE-MARK-THING))
;  (com-save-region)
;  (COM-MOVE-TO-PREVIOUS-POINT)
;  (com-yank)  ;;yanks too much!
;  (SETQ *MARK-STAYS* nil)
;  DIS-TEXT)

;(install-command-and-advertise 'COM-MOUSE-MOVE-THING-TO-CURSOR #/ *standard-comtab*	;install it.
;"")



(DEFUN PRINT-SHORT-DOC-FOR-TABLE (CHAR COMTAB INDENTATION)
  "Document what CHAR does in COMTAB, for subcommands of prefix characters.
It prints one or two lines of stuff, with the given INDENTATION."
  (LET ((X (COMMAND-LOOKUP CHAR COMTAB T)))
    (COND ((MEMQ X '(NIL :UNDEFINED)))		;undefined
	  ((CONSP X))				;alias
	  ((MACRO-COMMAND-P X)
	   (FORMAT T "~&~V@T~:C is a user defined macro.~%" INDENTATION CHAR))
	  ((PREFIX-COMMAND-P X)
	   (FORMAT T "~&~V@T~:C reads another character and dispatches.~%"
		   INDENTATION CHAR))
	  ((NOT (SYMBOLP X)))			;??
	  (T
	   (FORMAT T "~&~V@T~:C is ~A:~57T"	;more readably than with ~A:~%~@T"	
		   INDENTATION CHAR (COMMAND-NAME X) (+ 5 INDENTATION))
	   (PRINT-DOC :SHORT X CHAR)))))




(DEFCOM COM-FIND-DIRECTORY-FILES "Reads in all files in specified directory.
You type the name of a directory a la COM-DIRED, and all the files
in that directory are brought into the editor if not already in." ()
  (DOLIST (FILE (FS:DIRECTORY (READ-DIRECTORY-NAME "Read in files for directory:" (DEFAULT-PATHNAME))))
    (UNLESS (member (SEND FILE :TYPE) '("DIRECTORY" "DVI" "QFASL"))
      (LET ((SOURCE-PATHNAME (SEND FILE :SOURCE-PATHNAME)))
	(UNLESS (FIND-FILE-BUFFER SOURCE-PATHNAME)
	  (LET ((BUFFER (MAKE-INSTANCE 'ZMACS-BUFFER)))
	    (REVERT-BUFFER BUFFER SOURCE-PATHNAME 'NOSECTIONIZE NIL)
	    (MAKE-BUFFER-CURRENT BUFFER)
	    (SECTIONIZE-BUFFER BUFFER)
	    (NOT-MODIFIED BUFFER)
	    (SETF (BUFFER-FILE-READ-TICK BUFFER) *TICK*))))))
  DIS-TEXT)


(defcom com-bury-buffer "" ()
  (WITHOUT-INTERRUPTS
    (DOLIST (W *ALL-ZMACS-WINDOWS*)
      (LET ((HISTORY (SEND W :BUFFER-HISTORY)))
	(APPEND-REMOVE-ON-HISTORY *interval* HISTORY)))
    (SETQ *ZMACS-BUFFER-LIST* (APPEND (REMQ *interval* *ZMACS-BUFFER-LIST*)
				      (LIST *interval*)))
    (MAKE-BUFFER-CURRENT (first *zmacs-buffer-list*)))
  dis-text)


(defcom com-rotate-buffer-stack "Control-H" ()
  (let ((*numeric-arg* (- (length *zmacs-buffer-list*) 3)))	;weirdo fencepost error!
    (com-select-previous-buffer))
  dis-text)

(DEFCOM COM-FILL-TEXT-BUFFER "Fill (or adjust) the entire buffer." ()
  (FILL-INTERVAL (interval-first-bp *interval*)
		 (interval-last-bp *interval*)
		 T (AND *NUMERIC-ARG-P* (PLUSP *NUMERIC-ARG*)))
  DIS-TEXT)


(DEFCOM COM-FILL-LISP-BUFFER "Fill (or adjust) an entire lisp buffer." ()
  (INDENT-INTERVAL-FOR-LISP *interval*)
  DIS-TEXT)


;;;Feature: Reads in all files currently without zmacs buffers in the 
;;;background after accepting tag table name as unique.  Alerts when
;;;done.
;;;
;;;Feature: Allows specification of identical sets of files for multiple
;;;tag tables (as long as they are given different names).
;;;
;;;Caveat (not specific to this code): Tag table names are not case sensitive!
;;;
;;;Warning: Full defaulting is in effect here, so all versions of a file 
;;;are used if you do not specify otherwise!
;;;

(defvariable *zmacs-prefer-preload-tag-table-files-in-background* T :boolean)

(defcom com-select-files-as-tag-table "Prompts for and selects files to use as a tag table.
  With a numeric argument, reads in all specified files in the background." ()
  (let* ((pathname (merge-pathnames (read-defaulted-pathname "File or files to use as tag table:"
							     (default-pathname))
				    (default-pathname)))
	 (file-list (directory pathname)))
    (if (null file-list)
	(barf "No files match ~A" pathname)
      (let ((tag-table-name (typein-line-readline "Name for this tag table:")))
	(SELECT-FILE-LIST-AS-TAG-TABLE
	  file-list
	  (do ((used-name tag-table-name
			  (typein-line-readline 
			    (format nil "/"~a/" is already the name of a tag table. ~
				       Please enter another name for this new one:"
				    used-name))))
	      (nil)
	    (if (not (ass #'string-equal used-name *zmacs-tag-table-alist*))
		(return used-name))))
	;;;Optionally, pre-load all files
	(when (or *zmacs-prefer-preload-tag-table-files-in-background* *numeric-arg-p*)
	  (process-run-function `(:name ,(format nil "Loading of ~A" tag-table-name)
					:priority -1)	;don't subordinate front-line file transactions
				#'(lambda (files window)
				    (dolist (file files) (if (not (find-file-buffer file))
							     (load-file-into-zmacs file nil)))
				    (tv:careful-notify
				      window t
				      "The files of ~A have been loaded into ZMacs and selected as current tag table."
				      tag-table-name))
				;;Args to background file-finding function:
				file-list *window*)))
      ;;;Done.
      (format *query-io* "Done.")))
  DIS-NONE)

;;;;;;;;;;
;;;;;;;;;; Now install all newly-defined commands, and announce changes to existing functionalities.
;;;;;;;;;;

(send terminal-io :clear-screen)

(install-command-and-advertise 'com-select-files-as-tag-table #/Meta-Shift-S *zmacs-comtab*	;install it.
			       "~%Meta-Shift-S now selects user-specified files as a tag table.")





(format *query-io* "~%Control-U argument to Meta-X Kill or Save Buffers ~
                     now initially marks all buffers for killing.")

(install-command-and-advertise 'com-fill-lisp-buffer #/Control-Meta-Shift-F *zmacs-comtab*	;install it.
			       "~%Control-Meta-Shift-F now justifies all defuns in a Lisp buffer.")


(install-command-and-advertise 'com-fill-text-buffer #/Meta-Shift-F *zmacs-comtab*	;install it.
			       "~%Meta-Shift-F now fills all paragraphs in a text buffer.")



(install-command-and-advertise 'com-rotate-buffer-stack
			       #/c-H *standard-comtab*	;install it.
			       "~%Control-H now rotates the buffer stack (last one becomes new first one).")

(install-command-and-advertise 'com-bury-buffer #/c-I *standard-comtab*	;install it.
			       "~%Control-I now buries the current buffer in the current buffer list.")

(install-command-and-advertise 'com-find-directory-files #/s-t *standard-comtab*	;install it.
			       "~%Super-T now reads in all files of a directory (which you specify in a minibuffer).")

(install-command-and-advertise 'COM-STRING-SEARCH-SELECT-BUFFERS-AS-TAG-TABLE #/c-m-s *standard-comtab* 
       "~%Control-Meta-s now selects buffers as tag table using a user-specified string search on buffer names.")