;;;
;;; Corman Lisp 3.0 patch 3
;;;

#|
Change 2754 by rcorman@roger-laptop on 2007/01/26 00:52:59

	Turned off buffer security checking, which would sometimes cause 
	load-image to fail. It modifies the stack, and this behavior gets 
	detected by this check.

Affected files ...
//depot/CormanLisp/CormanLispServer/CormanLispServer.vcproj#12 edit
//depot/CormanLisp/CormanLispServer/Makefile#6 edit
//depot/CormanLisp/CormanLispServer/src/Gc.cpp#49 edit
//depot/CormanLisp/dlltemplate/dlltemplate.vcproj#10 edit

Change 2780 by rcorman@roger-laptop on 2007/02/12 01:46:31

	Fixed a (potential) problem with garbage collection.

Affected files ...
//depot/CormanLisp/CormanLispServer/CormanLispServer.vcproj#13 edit
//depot/CormanLisp/CormanLispServer/src/Gc.cpp#50 edit
//depot/CormanLisp/clboot/clboot.vcproj#8 edit
//depot/CormanLisp/dlltemplate/dlltemplate.vcproj#11 edit

Change 2802 by rcorman@CORMAN-R-XP4 on 2007/03/16 09:06:49

	Added asdf module.

Affected files ...
//depot/CormanLisp/Modules/asdf.lisp#1 add

Change 2803 by rcorman@CORMAN-R-XP4 on 2007/03/16 17:51:37

	Colorize problem--fixed some save/restore issues.

Affected files ...
//depot/CormanLisp/CormanLispIDE/src/CormanLisp.cpp#89 edit

|#

(in-package :ccl)

(defpatch 3 
    :install-func install-patch-3
    :uninstall-func uninstall-patch-3)

(defstruct patch-dirs live-path backup-path relative-path)
(defun create-patch-dirs (live-root backup-root relative-path)
    (let ((dirs 
                (make-patch-dirs
                :live-path (merge-pathnames relative-path live-root)
                :backup-path (merge-pathnames relative-path backup-root)
                :relative-path relative-path)))
        (ensure-directories-exist (patch-dirs-backup-path dirs))
        dirs))

(defparameter temp-file-num 0)
(defun make-temp-file-name (src)
    (make-pathname 
        :directory (pathname-directory src) 
        :name (format nil "~A~A~D" (pathname-name src) "_temp" temp-file-num) 
        :type (pathname-type src)))
    
(defun handle-protected-file (filename src)
    ;; if we are overwriting the kernel, we need to rename it first since it is currently running
    (when (or (equalp filename "cormanlispserver.dll") 
            (equalp filename "CormanLisp.exe")
            (equalp filename "CLConsole.exe"))
        (let* ((temp-file (make-temp-file-name src)))
            (if (probe-file temp-file)
                (delete-file temp-file))
            (do ((file-exists (probe-file temp-file)(probe-file temp-file)))		;; if it failed to delete
                ((not file-exists)(return))
                (incf temp-file-num)
                (setq temp-file (make-temp-file-name src)))
            (rename-file src temp-file))))
        
(defun process-patch-file (filename dirs)
    (let ((src (merge-pathnames filename (patch-dirs-live-path dirs))))
        (copy-file src
            (merge-pathnames filename (patch-dirs-backup-path dirs)))
        (handle-protected-file filename src)        
        (ensure-writable-file src)
        (sockets:get-http-file 
            *patch-server*
            (format nil "~A~D/~A~A" 
                *patch-root-directory*
                (cormanlisp-patch-level *patch*)
                (patch-dirs-relative-path dirs)
                filename)
            src)))

(defun process-patch-rollback-file (filename dirs)
    (let ((src (merge-pathnames filename (patch-dirs-live-path dirs))))
        (handle-protected-file filename src)        
        (ensure-writable-file src)
        (copy-file (merge-pathnames filename (patch-dirs-backup-path dirs)) src)))
    
(let ((clboot-files '("clboot.vcproj"))
      (CormanLispServer-files '("CormanLispServer.vcproj" "Makefile"))
      (CormanLispServer-src-files '("Gc.cpp"))
      (modules-files '("asdf.lisp"))
      (root-files
            '("CormanLispServer.dll"
              "CormanLisp.exe"
              "clbootapp.exe"
              "clconsoleapp.exe"
              "dlltemplate.dll"))
	  (patch-level (cormanlisp-patch-level *patch*)))
               
    (defun install-patch-3 ()
        (format *terminal-io* "Downloading new files, please wait...~%")
        (force-output *terminal-io*)
        (let* ((backup-dir (ccl::local-patches-backup-directory patch-level))
               (clboot-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "clboot/"))
               (CormanLispServer-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "CormanLispServer/"))
               (CormanLispServer-src-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "CormanLispServer/src/"))
               (modules-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "modules/"))
               (root-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "")))
                        
            (dolist (f clboot-files)
                (process-patch-file f clboot-dirs))
            (dolist (f CormanLispServer-files)
                (process-patch-file f CormanLispServer-dirs))
            (dolist (f CormanLispServer-src-files)
                (process-patch-file f CormanLispServer-src-dirs))
            (dolist (f modules-files)
                (process-patch-file f modules-dirs))
            (dolist (f root-files)
                (process-patch-file f root-dirs))))           
    
    (defun uninstall-patch-3 ()
        (let* ((backup-dir (ccl::local-patches-backup-directory patch-level))
               (clboot-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "clboot/"))
               (CormanLispServer-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "CormanLispServer/"))
               (CormanLispServer-src-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "CormanLispServer/src/"))
               (modules-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "modules/"))
               (root-dirs (create-patch-dirs *cormanlisp-directory* backup-dir "")))
                
            (dolist (f clboot-files)
                (process-patch-rollback-file f clboot-dirs))
            (dolist (f CormanLispServer-files)
                (process-patch-rollback-file f CormanLispServer-dirs))
            (dolist (f CormanLispServer-src-files)
                (process-patch-rollback-file f CormanLispServer-src-dirs))
            (dolist (f modules-files)
                (process-patch-rollback-file f modules-dirs))
            (dolist (f root-files)
                (process-patch-rollback-file f root-dirs)))))