[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

utility for cleaning up old versions of systems



	
	A while back someone posted a utility for deleting files
	associated with old versions of systems. Can someone refresh
	my memory as to who posted that utility so I can request a
	copy.

I cannot refresh your memory but the general facility you're after is
SCT:DEFINE-SYSTEM-OPERATION. See the documentation. Below is code
which I use to set the :DONT-DELETE flag uniformly for all files which
make up a given version of a system. -- Bud Frawley

1; --------------------------------------------------------------------

; Defines a function named 2DELETE-PROTECT-SYSTEM1 which can either set
; or remove the DONT-DELETE flag of all the files of a particular
; version of a system. Its ARGLIST is 
;   (SYSTEM-NAME &rest KEYS
;                &key (QUERY :CONFIRM) (SILENT NIL)
;	              (BATCH NIL) (DELETE-PROTECT T)
;	              (INCLUDE-COMPONENTS T) (VERSION :LATEST)
;	              &ALLOW-OTHER-KEYS)

0(sct:define-system-operation 2:delete-protect
0  #'(zl:named-lambda delete-protect-system-driver
		  (file ignore ignore &rest keys &key delete-protect &allow-other-keys)
      (ignore keys)
      (fs:change-file-properties file t :dont-delete delete-protect))
  #'(zl:named-lambda delete-protect-system-documentation
		  (file ignore ignore &rest keys &key delete-protect &allow-other-keys)
      (ignore keys)
      (format *standard-output*
	      "~&~:[Un-delete~;Delete~] protect~[~;ing~;ed~] file ~A"
	      delete-protect sct:*system-pass* file))
  :arglist
  (system-name &rest keys
	       &key (query :confirm) silent batch
	       (delete-protect t) (include-components t) (version :latest)
	       &allow-other-keys)
  :encache nil
  :class :simple
  :plan-filter
  #'(zl:named-lambda delete-protect-system-filter (system-op file module &rest ignore)
      (ignore system-op module)
      (not (fs:pathname-vc-p file))))