;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.129
;;; Reason:
;;;  DIRED's Next Hog command was badly broken. Problems included 1) stopping
;;;  at directories because they looked like hogs, but couldn't be; 2) not
;;;  being able to detect the first file group in a display as hoggy; 3)
;;;  thinking it was at the end of the display when it wasn't (e.g. on a
;;;  blank line at top of display).  This has been bothering me for almost 3
;;;  years, and I had nothing better to do while I watches system 125
;;;  compile, again.
;;;  
;;;  ***Please exercise this patch by checking out 'Next Hogs' over the next
;;;  couple of days. I've changed the control structure quite a bit, and
;;;  tested all kinds of cases, but you'll probably come up with situations I
;;;  didn't test.
;;; Written 7-Jul-88 02:58:31 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 1
;;; with Experimental System 124.128, Experimental Local-File 74.3, Experimental File-Server 23.1, Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, Tiger 28.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, Beta 3 plus patches.



; From file DJ: L.ZWEI; DIRED.LISP#335 at 7-Jul-88 02:58:32
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DIRED  "

(DEFCOM COM-DIRED-NEXT-HOG "Find the next file with superfluous versions.
  Points to next file with more than N versions, where N is the value of the variable
  *FILE-VERSIONS-KEPT*, or the numeric command argument if one is supplied." ()
  (LET* ((HOG (IF *NUMERIC-ARG-P* *NUMERIC-ARG* *FILE-VERSIONS-KEPT*))
	 (LINE (BP-LINE (POINT)))
	 (STOP-LINE (BP-LINE (INTERVAL-LAST-BP *INTERVAL*)))
	 (skip-p T)			   ;Controls skipping past current pathname
	 first-line			   ;Holds first line in group of files
	 PATHNAME			   ;Holds current pathname
	 (no-more-msg "No more files with excess versions in this display."))
    ;;Initial skipping
    (do-forever				;Do until out of header or buffer.
      (if (eq line stop-line)		;If at the end of the buffer,
	     (barf no-more-msg))	;  get out here.
      (when (SETQ PATHNAME (DIRED-LINE-PATHNAME LINE)) (return))
      ;;No pathname here yet.  So don't skip first file.
      (setq skip-p nil)
      ;;Get next line, call it first line in first group.
      (SETQ LINE (LINE-NEXT LINE))
      (setq first-line line))
    ;;Find the hogs:
    (DO ((LINE LINE (LINE-NEXT LINE))
	 (dirs (send pathname :directory)) ;Directory of file in beginning of group.
					   ;  {Works for detecting series of empty dirs.}
	 (NAME (SEND PATHNAME :NAME))	   ; Name of file in beginning of group.
	 (TYPE (SEND PATHNAME :TYPE))	   ; Type "   "    "    "       "   "
	 (N-VERSIONS 0))		   ;Number of versions seen so far.
	((EQ LINE STOP-LINE)		   ;If we're at the end,
	 (progn (move-bp (point) line 0)   ;  move display there,
		(BARF no-more-msg)))	   ;  and get out here.
      ;;In loop, examining a new pathname:
      (SETQ PATHNAME (DIRED-LINE-PATHNAME LINE))
      Check-Again
      (AND PATHNAME
	   (COND ((AND (equal dirs (send pathname :directory))
		       (EQUAL NAME (SEND PATHNAME :NAME))
		       (EQUAL TYPE (SEND PATHNAME :TYPE)))
		  ;;We have same file, different version!
		  (COND (skip-p)	   ;Skipping through original file.
			((> (SETQ N-VERSIONS (1+ N-VERSIONS)) HOG)
			 ;;We have a hog.
			 (MOVE-BP (POINT) FIRST-LINE 0)
			 (RETURN (NEXT-HOG-REDISPLAY LINE STOP-LINE NAME TYPE)))))
		 (T (SETQ SKIP-P NIL
			  dirs (send pathname :directory)
			  NAME (SEND PATHNAME :NAME)
			  TYPE (SEND PATHNAME :TYPE)
			  N-VERSIONS 0
			  FIRST-LINE LINE)
		    (GO Check-Again)))))))

))