raco pkg: add trash directory for removed/updated package installations

Packages that are installed as other than a link are not meant to be
edited, but work can get lost if a package is edited and then removed
or updated. Avoid that work loss by moving removed or updated packages
to a trash folder.

By default, the trash folder holds up to 512 packages for up to 48
hours. To disable the trash folder (for a given scope), use

 raco pkg config --set max-trash-packages 0

(I expect that some variant of Greenspun's rule predicted the eventual
inclusion of "backup" management in the package system.)

pkgs/racket-doc/pkg/scribblings/apis.scrbl

@@ -45,6 +45,8 @@ to the @exec{raco pkg} sub-subcommands.
                                                   @history[#:added "6.0.17"]}
 @defthing[pkg-archive-command procedure?]{Implements @command-ref{archive}.
                                                   @history[#:added "6.1.0.8"]}
+@defthing[pkg-empty-trash-command procedure?]{Implements @command-ref{empty-trash}.
+                                                  @history[#:added "6.1.1.6"]}
 
 @include-section["lib.scrbl"]
 @include-section["path.scrbl"]

pkgs/racket-doc/pkg/scribblings/lib.scrbl

@@ -91,6 +91,18 @@ a parameter's value is @racket[#f], then the user's configuration is
 used.}
 
 
+@deftogether[(
+@defparam[current-pkg-trash-max-packages max-packages (or/c #f real?)]
+@defparam[current-pkg-trash-max-seconds max-seconds (or/c #f real?)]
+)]{
+
+Parameters that determine the trash-directory limits.  If
+a parameter's value is @racket[#f], then the user's configuration is
+used.
+
+@history[#:added "6.1.1.6"]}
+
+
 @defproc[(pkg-directory [name string?]
                         [#:cache cache (or/c #f (and/c hash? (not/c immutable?))) #f])
          (or/c path-string? #f)]{
@@ -234,7 +246,8 @@ is true, error messages may suggest specific command-line flags for
                            [#:ignore-checksums? ignore-checksums? boolean? #f]
                            [#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f]
                            [#:use-cache? use-cache? boolean? #t]
-                           [#:quiet? boolean? quiet? #f]
+                           [#:quiet? quiet? boolean? #f]
+                           [#:use-trash? use-trash? boolean? #f]
                            [#:from-command-line? from-command-line? boolean? #f]
                            [#:strip strip (or/c #f 'source 'binary 'binary-lib) #f]
                            [#:force-strip? force-string? boolean? #f]
@@ -268,7 +281,11 @@ port, unless @racket[quiet?] is true.
 If @racket[from-command-line?]  is true, error messages may suggest
 specific command-line flags for @command-ref{install}.
 
-The package lock must be held; see @racket[with-pkg-lock].}
+The package lock must be held; see @racket[with-pkg-lock].
+
+@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode] 
+                                   and @racket[#:infer-clone-from-dir?] arguments.}
+         #:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}]}
 
 
 @defproc[(pkg-update      [sources (listof (or/c string? pkg-desc?))]
@@ -281,7 +298,8 @@ The package lock must be held; see @racket[with-pkg-lock].}
                           [#:ignore-checksums? ignore-checksums? boolean? #f]
                           [#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f]
                           [#:use-cache? use-cache? quiet? #t]
-                          [#:quiet? boolean? quiet? #f]
+                          [#:quiet? quiet? boolean? #f]
+                          [#:use-trash? boolean? use-trash? #f]
                           [#:from-command-line? from-command-line? boolean? #f]
                           [#:strip strip (or/c #f 'source 'binary 'binary-lib) #f]
                           [#:force-strip? force-string? boolean? #f]
@@ -318,14 +336,19 @@ corresponds to an existing repository-clone installation.
 If @racket[from-command-line?]  is true, error messages may suggest
 specific command-line flags for @command-ref{update}.
 
-The package lock must be held; see @racket[with-pkg-lock].}
+The package lock must be held; see @racket[with-pkg-lock].
+
+@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode] 
+                                   and @racket[#:infer-clone-from-dir?] arguments.}
+         #:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}]}
 
 
 @defproc[(pkg-remove      [names (listof string?)]
                           [#:demote? demote? boolean? #f]
                           [#:auto? auto? boolean? #f]
                           [#:force? force? boolean? #f]
-                          [#:quiet? boolean? quiet? #f]
+                          [#:quiet? quiet? boolean? #f]
+                          [#:use-trash? boolean? use-trash? #f]
                           [#:from-command-line? from-command-line? boolean? #f])
          (or/c 'skip
                #f
@@ -339,7 +362,9 @@ Implements @racket[pkg-remove-command]. The result is the same as for
 If @racket[from-command-line?]  is true, error messages may suggest
 specific command-line flags for @command-ref{remove}.
 
-The package lock must be held; see @racket[with-pkg-lock].}
+The package lock must be held; see @racket[with-pkg-lock].
+
+@history[#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}]}
 
 
 @defproc[(pkg-new [name path-string?])
@@ -374,7 +399,7 @@ The package lock must be held to allow reads; see
                            [#:use-cache? use-cache? boolean? #t]
                            [#:ignore-checksums? ignore-checksums? boolean? #f]
                            [#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f]
-                           [#:quiet? boolean? quiet? #f]
+                           [#:quiet? quiet? boolean? #f]
                            [#:from-command-line? from-command-line? boolean? #f]
                            [#:strip strip (or/c #f 'source 'binary 'binary-lib) #f]
                            [#:force-strip? force-string? boolean? #f])
@@ -471,6 +496,15 @@ would allow archiving to continue for other packages.
 @history[#:added "6.1.0.8"]}
 
 
+@defproc[(pkg-empty-trash [#:list? show-list? boolean? #f]
+                          [#:quiet? quiet? boolean? #t])
+         void?]{
+
+Implements @racket[pkg-empty-trash].
+
+@history[#:added "6.1.1.6"]}
+
+
 @defproc[(pkg-catalog-update-local [#:catalogs catalogs (listof string?) (pkg-config-catalogs)]
                                    [#:catalog-file catalog-file path-string? (current-pkg-catalog-file)]
                                    [#:quiet? quiet? boolean? #f]

pkgs/racket-doc/pkg/scribblings/pkg.scrbl

@@ -573,11 +573,14 @@ sub-commands.
   @item{@DFlag{batch} --- Disables @deftech{interactive mode}, suppressing potential prompts for a user
                           (e.g., about package dependencies or clone sharing).}
 
+  @item{@DFlag{no-trash} --- Refrain from moving updated or removed packages to a trash folder.}
+
   @item{@DFlag{fail-fast} --- Breaks @exec{raco setup} as soon as any error is encountered.}
  ]
 
 @history[#:changed "6.1.1.5" @elem{Added the @DFlag{batch}, @DFlag{clone}, and
-                                   @DFlag{multi-clone} flags.}]}
+                                   @DFlag{multi-clone} flags.}
+         #:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag.}]}
 
 
 @subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg-source} ... 
@@ -671,12 +674,14 @@ the given @nonterm{pkg-source}s.
  @item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
  @item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
  @item{@DFlag{batch} --- Same as for @command-ref{install}.}
+ @item{@DFlag{no-trash} --- Same as for @command-ref{install}.}
  ]
 
 @history[#:changed "6.1.1.5" @elem{Added the @DFlag{batch}, @DFlag{clone}, and
                                    @DFlag{multi-clone} flags, and
                                    added update of enclosing package
-                                   when no arguments are provided.}]}
+                                   when no arguments are provided.}
+         #:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag.}]}
 
 @subcommand{@command/toc{remove} @nonterm{option} ... @nonterm{pkg} ... 
 --- Attempts to remove the given packages. By default, if a package is the dependency
@@ -705,9 +710,11 @@ the given @nonterm{pkg}s.
  @item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
  @item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
  @item{@DFlag{batch} --- Same as for @command-ref{install}.}
+ @item{@DFlag{no-trash} --- Same as for @command-ref{install}.}
  ]
 
-@history[#:changed "6.1.1.5" @elem{Added the @DFlag{batch} flag.}]}
+@history[#:changed "6.1.1.5" @elem{Added the @DFlag{batch} flag.}
+         #:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag.}]}
 
 
 @subcommand{@command/toc{new} @nonterm{pkg} ---
@@ -856,8 +863,16 @@ for @nonterm{key}.
         documentation; an empty string, which is the default, disables
         the URL so that the local filesystem is used. This key can be
         set only in @exec{installation} scope.}
+  @item{@exec{trash-max-packages} --- A limit on the number of package implementations
+        that are kept in a trash folder when the package is removed or updated.}
+  @item{@exec{trash-max-seconds} --- A limit on the time since a package is removed or
+        updated that its implementation is kept in the trash folder. Package implementations are
+        removed from a trash folder only when another package is potentially added
+        to the trash folder or @command-ref{empty-trash} is used.}
  ]
-}
+
+@history[#:changed "6.1.1.6" @elem{Added @exec{trash-max-packages} and @exec{trash-max-seconds}.}]}
+
 
 @subcommand{@command/toc{catalog-show} @nonterm{option} ... @nonterm{package-name} ...
 --- Consults @tech{package catalogs} for a package (that is not necessarily installed)
@@ -961,12 +976,35 @@ for @nonterm{key}.
  @item{@DFlag{exclude} @nonterm{pkg} --- Omits the specified @nonterm{pkg} from the
         resulting catalog. This also causes the dependencies of @nonterm{pkg} to be
         omitted if @DFlag{include-deps} is specified. This flag can be provided multiple times.}
- @item{@DFlag{relative} --- Write package sources to @nonterm{dest-catalog} in relative-path form.}
+ @item{@DFlag{relative} --- Writes package sources to @nonterm{dest-catalog} in relative-path form.}
  ]
 
  @history[#:added "6.1.0.8"]
 }
 
+@subcommand{@command/toc{empty-trash} @nonterm{option} ...
+--- Removes or lists package implementations that were previously removed or updated and
+    are currently in the trash directory
+    for the specified @tech{package scope}. The @exec{trash-max-packages} and
+    @exec{trash-max-seconds} configuration keys (see @command-ref{config}) control
+    how many packages are kept in the trash directory and for how long.
+
+    The @exec{empty-trash} sub-command accepts
+    the following @nonterm{option}s:
+
+ @itemlist[
+ @item{@DFlag{scope} @nonterm{scope} --- Selects a @tech{package scope}, the same as for @command-ref{install}.}
+ @item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.}
+ @item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
+ @item{@DFlag{scope-dir} @nonterm{dir} --- Same as for @command-ref{install}.}
+
+ @item{@DFlag{list} or @Flag{l} --- Shows the trash directory path and its content, instead of
+                                    removing the current content.}
+ ]
+
+ @history[#:added "6.1.1.6"]
+}
+
 @; ----------------------------------------
 
 @section[#:tag "metadata"]{Package Metadata}

pkgs/racket-test/tests/pkg/test.rkt

@@ -49,6 +49,7 @@
  "update-deps"
  "update-auto"
  "scope"
+ "trash"
  "migrate"
  "versions"
  "platform"

pkgs/racket-test/tests/pkg/tests-failure.rkt

@@ -17,7 +17,7 @@
     $ "raco pkg show -l -u -a -d" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source +Directory\npkg-test1 +[a-f0-9]+ .*pkg-test1\"\n"
     $ "racket -e '(require pkg-test1)'" =exit> 0
     $ "racket -e '(file-or-directory-permissions (collection-path \"pkg-test1\") #o500)'"
-    $ "raco pkg remove pkg-test1" =exit> 1
+    $ "raco pkg remove --no-trash pkg-test1" =exit> 1
     $ "racket -e '(require pkg-test1)'" =exit> 1)
 
    (shelly-case

pkgs/racket-test/tests/pkg/tests-scope.rkt

@@ -53,7 +53,7 @@
     $ "raco pkg install -u --copy test-pkgs/pkg-test1"
     $ "racket -l pkg-test1"  =stdout> #rx"main loaded"
     $ "raco pkg install -i --copy test-pkgs/pkg-test1" =exit> 1 =stderr> #rx"packages in different scopes conflict"
-    $ "raco pkg remove pkg-test1" =stdout> "Removing pkg-test1\n")
+    $ "raco pkg remove --no-trash pkg-test1" =stdout> "Removing pkg-test1\n")
 
    (shelly-case
     "override conflist, installation first"
@@ -62,7 +62,7 @@
     $ "raco pkg install -u --name pkg-test1 --copy test-pkgs/pkg-test1-v2" =exit> 1
     $ "raco pkg install --force -u --name pkg-test1 --copy test-pkgs/pkg-test1-v2"
     $ "racket -l racket/base -l pkg-test1/number -e '(number)'"  =stdout> "2\n"
-    $ "raco pkg remove pkg-test1" =stdout> "Removing pkg-test1\n"
+    $ "raco pkg remove --no-trash pkg-test1" =stdout> "Removing pkg-test1\n"
     $ "racket -l racket/base -l pkg-test1/number -e '(number)'"  =stdout> "1\n"
     $ "raco pkg remove pkg-test1" =stdout> #rx"Inferred package scope: installation")
 
@@ -73,7 +73,7 @@
     $ "raco pkg install -i --name pkg-test1 --copy test-pkgs/pkg-test1-v2" =exit> 1
     $ "raco pkg install --force -i --name pkg-test1 --copy test-pkgs/pkg-test1-v2"
     $ "racket -l racket/base -l pkg-test1/number -e '(number)'"  =stdout> "1\n"
-    $ "raco pkg remove pkg-test1" =stdout> "Removing pkg-test1\n"
+    $ "raco pkg remove --no-trash pkg-test1" =stdout> "Removing pkg-test1\n"
     $ "racket -l racket/base -l pkg-test1/number -e '(number)'"  =stdout> "2\n"
     $ "raco pkg remove pkg-test1" =stdout> #rx"Inferred package scope: installation")
 

pkgs/racket-test/tests/pkg/tests-trash.rkt

@@ -0,0 +1,53 @@
+#lang racket/base
+(require "util.rkt"
+         "shelly.rkt")
+
+(this-test-is-run-by-the-main-test)
+
+(pkg-tests
+ (with-fake-root
+     (shelly-begin
+
+      (define (check-empty)
+        (shelly-begin
+         $ "raco pkg empty-trash -l" =stdout> #rx"  \\[(none|does not exist)\\]\n"))
+      
+      (define (add-remove)
+        (shelly-begin
+         $ "raco pkg install test-pkgs/pkg-test1.zip"
+         $ "raco pkg remove pkg-test1"))
+      
+      (define (check-single)
+        (shelly-begin
+         $ "raco pkg empty-trash -l" =stdout> #rx"Content:\n  [0-9]+-0-pkg-test1\n$"))
+
+      (define (check-double)
+        (shelly-begin
+         $ "raco pkg empty-trash -l" =stdout> #rx"Content:\n  [0-9]+-0-pkg-test1\n  [0-9]*-.-pkg-test1\n$"))
+      
+      $ "raco pkg install test-pkgs/pkg-test1.zip"
+      $ "raco pkg remove --no-trash pkg-test1"
+      (check-empty)
+      
+      
+      (add-remove)
+      (check-single)
+      
+      (add-remove)
+      (check-double)
+
+      $ "raco pkg empty-trash"
+      (check-empty)
+      
+      $ "raco pkg config --set trash-max-packages 1"
+      (add-remove)
+      (check-single)
+      (add-remove)
+      (check-single)
+      $ "raco pkg config --set trash-max-packages 10"
+      (add-remove)
+      (check-double)
+      
+      $ "raco pkg config --set trash-max-seconds 0"
+      (add-remove)
+      (check-single))))

racket/collects/pkg/lib.rkt

@@ -25,7 +25,8 @@
          "private/catalog-update.rkt"
          "private/catalog-archive.rkt"
          "private/suggestions.rkt"
-         "private/archive.rkt")
+         "private/archive.rkt"
+         "private/trash.rkt")
   
 (define dep-behavior/c
   (or/c #f 'fail 'force 'search-ask 'search-auto))
@@ -62,6 +63,10 @@
    (parameter/c (or/c #f real?))]
   [current-pkg-download-cache-max-bytes
    (parameter/c (or/c #f real?))]
+  [current-pkg-trash-max-packages
+   (parameter/c (or/c #f real?))]
+  [current-pkg-trash-max-seconds
+   (parameter/c (or/c #f real?))]
   [pkg-directory
    (->* (string?)
         (#:cache (or/c #f (and/c hash? (not/c immutable?))))
@@ -98,6 +103,7 @@
                         #:update-deps? boolean?
                         #:update-implies? boolean?
                         #:quiet? boolean?
+                        #:use-trash? boolean?
                         #:from-command-line? boolean?
                         #:all-platforms? boolean?
                         #:force? boolean?
@@ -116,6 +122,7 @@
         (#:auto? boolean?
                  #:force? boolean?
                  #:quiet? boolean?
+                 #:use-trash? boolean?
                  #:from-command-line? boolean?
                  #:demote? boolean?)
         (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
@@ -137,6 +144,7 @@
                         #:use-cache? boolean?
                         #:skip-installed? boolean?
                         #:quiet? boolean?
+                        #:use-trash? boolean?
                         #:from-command-line? boolean?
                         #:strip (or/c #f 'source 'binary 'binary-lib)
                         #:force-strip? boolean?
@@ -186,6 +194,11 @@
                          #:quiet? boolean?
                          #:package-exn-handler (string? exn:fail? . -> . any))
         void?)]
+  [pkg-empty-trash
+   (->* ()
+        (#:list? boolean?
+                 #:quiet? boolean?)
+        void)]
   [default-pkg-scope
    (-> package-scope/c)]
   [installed-pkg-names

racket/collects/pkg/main.rkt

@@ -134,6 +134,7 @@
     (syntax-case stx ()
       [(_ #:scope-flags (scope-flags ...)
           #:job-flags (job-flags ...)
+          #:trash-flags (trash-flags ...)
           #:catalog-flags (catalog-flags ...)
           #:install-type-flags (install-type-flags ...)
           #:install-dep-flags (install-dep-flags ...)
@@ -146,6 +147,7 @@
           #:install-copy-checks (install-copy-checks ...))
        (with-syntax ([([scope-flags ...]
                        [job-flags ...]
+                       [trash-flags ...]
                        [catalog-flags ...]
                        [install-type-flags ...]
                        [(install-dep-flags ... (dep-desc ...))]
@@ -157,6 +159,7 @@
                        [install-copy-checks ...])
                       (syntax-local-introduce #'([scope-flags ...]
                                                  [job-flags ...]
+                                                 [trash-flags ...]
                                                  [catalog-flags ...]
                                                  [install-type-flags ...]
                                                  [install-dep-flags ...]
@@ -194,6 +197,7 @@
              install-force-flags ...
              install-clone-flags ...
              job-flags ...
+             trash-flags ...
              [#:bool fail-fast () ("Break `raco setup' when it discovers an error")]
              #:args pkg-source
              install-copy-defns ...
@@ -250,6 +254,7 @@
                                                                       'fail
                                                                       'ask))
                                        #:link-dirs? link-dirs?
+                                       #:use-trash? (not no-trash)
                                        (for/list ([p (in-list sources)])
                                          (pkg-desc p a-type* name checksum #f
                                                    #:path (and (eq? a-type* 'clone)
@@ -279,6 +284,7 @@
              install-force-flags ...
              install-clone-flags ...
              job-flags ...
+             trash-flags ...
              #:args pkg-source
              install-copy-defns ...
              (let ([pkg-source
@@ -342,7 +348,8 @@
                                                                      'fail
                                                                      'ask))
                                       #:link-dirs? link-dirs?
-                                      #:infer-clone-from-dir? (not (or link static-link copy))))))
+                                      #:infer-clone-from-dir? (not (or link static-link copy))
+                                      #:use-trash? (not no-trash)))))
                   (setup "updated" no-setup #f setup-collects jobs))))]
             ;; ----------------------------------------
             [remove
@@ -355,6 +362,7 @@
              scope-flags ...
              #:once-each
              job-flags ...
+             trash-flags ...
              #:args pkg
              (call-with-package-scope
               'remove
@@ -366,7 +374,8 @@
                                #:from-command-line? #t
                                #:demote? demote
                                #:auto? auto
-                               #:force? force)))
+                               #:force? force
+                               #:use-trash? (not no-trash))))
                 (setup "removed" no-setup #f setup-collects jobs)))]
             ;; ----------------------------------------
             [new
@@ -597,7 +606,21 @@
                                  (cons pkg pkgs)
                                  #:include-deps? include-deps
                                  #:exclude (exclude-list)
-                                 #:relative-sources? relative))]))]))
+                                 #:relative-sources? relative))]
+            ;; ----------------------------------------
+            [empty-trash
+             "Delete old package installations from the trash directory"
+             #:once-any
+             scope-flags ...
+             #:once-each
+             [#:bool list ("-l") "Show trash content without emptying"]
+             #:args ()
+             (call-with-package-scope
+              'empty-trash
+              scope scope-dir installation user #f #f #f #f
+              (lambda ()
+                (pkg-empty-trash #:list? list
+                                 #:quiet? #f)))]))]))
   (make-commands
    #:scope-flags
    ([(#:sym scope [installation user] #f) scope ()
@@ -611,6 +634,8 @@
    ([#:bool no-setup () ("Don't `raco setup' after changing packages (usually a bad idea)")]
     [(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
     [#:bool batch () ("Disable interactive mode and all prompts")])
+   #:trash-flags
+   ([#:bool no-trash () ("Delete uninstalled/updated, instead of moving to a trash folder")])
    #:catalog-flags
    ([(#:str catalog #f) catalog () "Use <catalog> instead of configured catalogs"])
    #:install-type-flags

racket/collects/pkg/path.rkt

@@ -109,12 +109,13 @@
      [(sub-path? < p d)
       ;; Under the installation mode's package directory.
       ;; We assume that no one else writes there, so the
-      ;; next path element is the package name (or the package
+      ;; next path element is the package name, the package
-      ;; name followed by "+<n>")
+      ;; name followed by "+<n>", or ".trash"
       (define len (length d))
       (define pkg-name (path-element->string (list-ref p len)))
-      (if (regexp-match? #rx"pkgs[.]rktd" pkg-name)
+      (if (or (regexp-match? #rx"pkgs[.]rktd" pkg-name)
-          (values #f #f #f #f) ; don't count the database as a package
+              (regexp-match? #rx"[.]trash" pkg-name))
+          (values #f #f #f #f) ; don't count the database or trash can as a package
           (values (if (regexp-match? #rx"[+]" pkg-name) ; +<n> used as an alternate path, sometimes
                       (regexp-replace #rx"[+].*$" pkg-name "")
                       pkg-name)

racket/collects/pkg/private/config.rkt

@@ -26,6 +26,13 @@
   (or (current-pkg-download-cache-max-bytes)
       (read-pkg-cfg/def 'download-cache-max-bytes)))
 
+(define (get-trash-max-packages)
+  (or (current-pkg-trash-max-packages)
+      (read-pkg-cfg/def 'trash-max-packages)))
+(define (get-trash-max-seconds)
+  (or (current-pkg-trash-max-seconds)
+      (read-pkg-cfg/def 'trash-max-seconds)))
+
 (define (read-pkg-cfg/def k)
   ;; Lock is held for the current scope, but if
   ;; the key is not found in the current scope,
@@ -42,6 +49,8 @@
                                        "download-cache")]
       ['download-cache-max-files 1024]
       ['download-cache-max-bytes (* 64 1024 1024)]
+      ['trash-max-packages 512]
+      ['trash-max-seconds (* 60 60 24 2)] ; 2 days
       [_ #f]))
   (define c (read-pkg-file-hash (pkg-config-file)))
   (define v (hash-ref c k 'none))
@@ -113,7 +122,9 @@
                        "download-cache-max-files"
                        "download-cache-max-bytes"
                        "download-cache-dir"
-                       "doc-open-url")))
+                       "doc-open-url"
+                       "trash-max-packages"
+                       "trash-max-seconds")))
         (pkg-error (~a "missing value for config key\n"
                        "  config key: ~a")
                    key)]
@@ -122,7 +133,10 @@
                         "name"
                         "download-cache-max-files"
                         "download-cache-max-bytes"
-                        "download-cache-dir"))
+                        "download-cache-dir"
+                        "doc-open-url"
+                        "trash-max-packages"
+                        "trash-max-seconds"))
                val
                another-val
                more-vals)
@@ -155,7 +169,9 @@
                                                   (path->string
                                                    (path->complete-path val))))]
        [(list (and key (or "download-cache-max-files"
-                           "download-cache-max-bytes"))
+                           "download-cache-max-bytes"
+                           "trash-max-packages"
+                           "trash-max-seconds"))
               val)
         (unless (real? (string->number val))
           (pkg-error (~a "invalid value for config key\n"
@@ -187,7 +203,9 @@
              (printf "~a~a\n" indent (read-pkg-cfg/def 'installation-name))]
             [(or "download-cache-dir"
                  "download-cache-max-files"
-                 "download-cache-max-bytes")
+                 "download-cache-max-bytes"
+                 "trash-max-packages"
+                 "trash-max-seconds")
              (printf "~a~a\n" indent (read-pkg-cfg/def (string->symbol key)))]
             ["doc-open-url"
              (printf "~a~a\n" indent (or (read-pkg-cfg/def 'doc-open-url) ""))]
@@ -207,7 +225,9 @@
                               "default-scope"
                               "download-cache-dir"
                               "download-cache-max-files"
-                              "download-cache-max-bytes"))])
+                              "download-cache-max-bytes"
+                              "trash-max-packages"
+                              "trash-max-seconds"))])
           (printf "~a:\n" key)
           (show (list key) "  "))]
        [_ (show key+vals "")])]))

racket/collects/pkg/private/install.rkt

@@ -135,6 +135,7 @@
          #:force? force?
          #:all-platforms? all-platforms?
          #:quiet? quiet?
+         #:use-trash? use-trash?
          #:from-command-line? from-command-line?
          #:conversation conversation
          #:strip strip-mode
@@ -424,7 +425,7 @@
                (let ()
                  (define (continue conversation)
                    (raise (vector #t infos pkg-name update-pkgs
-                                  (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) update-pkgs))
+                                  (λ () (for-each (compose (remove-package quiet? use-trash?) pkg-desc-name) update-pkgs))
                                   conversation
                                   clone-info)))
                  (match (if (andmap (lambda (dep) (set-member? implies (pkg-desc-name dep)))
@@ -526,7 +527,7 @@
                                                                #:from-command-line? from-command-line?
                                                                #:link-dirs? link-dirs?)
                                            update-pkgs)])
-                (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update))))
+                (λ () (for-each (compose (remove-package quiet? use-trash?) pkg-desc-name) to-update))))
             (match this-dep-behavior
               ['fail
                (clean!)
@@ -776,6 +777,7 @@
                      #:catalog-lookup-cache [catalog-lookup-cache (make-hash)]
                      #:updating? [updating? #f]
                      #:quiet? [quiet? #f]
+                     #:use-trash? [use-trash? #f]
                      #:from-command-line? [from-command-line? #f]
                      #:conversation [conversation #f]
                      #:strip [strip-mode #f]
@@ -785,9 +787,9 @@
                      #:multi-clone-behavior [old-clone-behavior 'fail]
                      #:repo-descs [old-repo-descs (initial-repo-descs
                                                    (read-pkg-db)
-                                                   (if quiet? void printf))]
+                                                   (if quiet? void printf/flush))]
                      #:convert-to-non-clone? [convert-to-non-clone? #f])
-  (define download-printf (if quiet? void printf))
+  (define download-printf (if quiet? void printf/flush))
   
   (define descs
     (map (convert-clone-name-to-clone-repo/install catalog-lookup-cache
@@ -833,6 +835,9 @@
                        #:catalog-lookup-cache catalog-lookup-cache
                        #:pre-succeed (lambda () (pre-succeed) (more-pre-succeed))
                        #:updating? updating?
+                       #:quiet? quiet?
+                       #:use-trash? use-trash?
+                       #:from-command-line? from-command-line?
                        #:conversation conv
                        #:strip strip-mode
                        #:force-strip? force-strip?
@@ -858,11 +863,12 @@
        #:catalog-lookup-cache catalog-lookup-cache
        #:pre-succeed (λ ()
                        (for ([pkg-name (in-hash-keys extra-updating)])
-                         ((remove-package quiet?) pkg-name))
+                         ((remove-package quiet? use-trash?) pkg-name))
                        (pre-succeed))
        #:updating? updating?
        #:extra-updating extra-updating
        #:quiet? quiet?
+       #:use-trash? use-trash?
        #:from-command-line? from-command-line?
        #:conversation conversation
        #:strip strip-mode
@@ -1093,6 +1099,7 @@
                     #:update-deps? [update-deps? #f]
                     #:update-implies? [update-implies? #t]
                     #:quiet? [quiet? #f]
+                    #:use-trash? [use-trash? #f]
                     #:from-command-line? [from-command-line? #f]
                     #:strip [strip-mode #f]
                     #:force-strip? [force-strip? #f]
@@ -1100,7 +1107,7 @@
                     #:infer-clone-from-dir? [infer-clone-from-dir? #f]
                     #:lookup-for-clone? [lookup-for-clone? #f]
                     #:multi-clone-behavior [clone-behavior 'fail])
-  (define download-printf (if quiet? void printf))
+  (define download-printf (if quiet? void printf/flush))
   (define metadata-ns (make-metadata-namespace))
   (define db (read-pkg-db))
   (define all-mode? (and all? (empty? in-pkgs)))
@@ -1157,13 +1164,14 @@
        (flush-output))
      (pkg-install
       #:updating? #t
-      #:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update))
+      #:pre-succeed (λ () (for-each (compose (remove-package quiet? use-trash?) pkg-desc-name) to-update))
       #:dep-behavior dep-behavior
       #:update-deps? update-deps?
       #:update-implies? update-implies?
       #:update-cache update-cache
       #:catalog-lookup-cache catalog-lookup-cache
       #:quiet? quiet?
+      #:use-trash? use-trash?
       #:from-command-line? from-command-line?
       #:strip strip-mode
       #:force-strip? force-strip?

racket/collects/pkg/private/params.rkt

@@ -27,3 +27,8 @@
 (define current-pkg-download-cache-max-bytes
   (make-parameter #f))
 
+(define current-pkg-trash-max-packages
+  (make-parameter #f))
+(define current-pkg-trash-max-seconds
+  (make-parameter #f))
+

racket/collects/pkg/private/remove.rkt

@@ -10,7 +10,8 @@
          "collects.rkt"
          "params.rkt"
          "print.rkt"
-         "get-info.rkt")
+         "get-info.rkt"
+         "trash.rkt")
 
 (provide remove-package
          pkg-remove)
@@ -24,7 +25,7 @@
         (printf/flush "Demoting ~a to auto-installed\n" pkg-name))
       (update-pkg-db! pkg-name (update-auto pi #t)))))
 
-(define ((remove-package quiet?) pkg-name)
+(define ((remove-package quiet? use-trash?) pkg-name)
   (unless quiet?
     (printf/flush "Removing ~a\n" pkg-name))
   (define db (read-pkg-db))
@@ -48,8 +49,14 @@
             #:user? user?
             #:file (scope->links-file scope)
             #:root? (not (sc-pkg-info? pi)))
-     (delete-directory/files pkg-dir)]))
+     (cond
-
+      [(and use-trash?
+            (select-trash-dest pkg-name))
+       => (lambda (trash-dest)
+            (printf/flush "Moving ~a to trash: ~a\n" pkg-name trash-dest)
+            (rename-file-or-directory pkg-dir trash-dest))]
+      [else
+       (delete-directory/files pkg-dir)])]))
       
 
 (define (pkg-remove given-pkgs
@@ -57,6 +64,7 @@
                     #:force? [force? #f]
                     #:auto? [auto? #f]
                     #:quiet? [quiet? #f]
+                    #:use-trash? [use-trash? #f]
                     #:from-command-line? [from-command-line? #f])
   (define db (read-pkg-db))
   (define all-pkgs
@@ -134,7 +142,7 @@
      (set->list (set-subtract (list->set in-pkgs)
                               (list->set remove-pkgs)))))
 
-  (for-each (remove-package quiet?)
+  (for-each (remove-package quiet? use-trash?)
             remove-pkgs)
 
   (cond

racket/collects/pkg/private/trash.rkt

@@ -0,0 +1,76 @@
+#lang racket/base
+(require racket/list
+         racket/file
+         "config.rkt"
+         "dirs.rkt"
+         "print.rkt"
+         "params.rkt")
+
+(provide select-trash-dest
+         pkg-empty-trash)
+
+(define (find-trash-dir) (build-path (pkg-dir #f) ".trash"))
+
+(define (select-trash-dest pkg-name
+                           #:remove-printf [remove-printf void])
+  (define max-packages (get-trash-max-packages))
+  (define max-seconds (get-trash-max-seconds))
+  (define trash-dir (find-trash-dir))
+  (make-directory* trash-dir)
+  (define (delete-trash f)
+    (define p (build-path trash-dir f))
+    (remove-printf "Removing trash directory ~a\n" p)
+    (log-pkg-info "Removing trash directory ~a" p)
+    (delete-directory/files p))
+  (define l (if (directory-exists? trash-dir)
+                (directory-list trash-dir)
+                null))
+  (let loop ([l l])
+    (cond
+     [(and (pair? l)
+           ((length l) . > . (sub1 max-packages)))
+      (delete-trash (car l))
+      (loop (cdr l))]
+     [(and (pair? l)
+           (let ([m (regexp-match #rx"^([0-9]+)-" (car l))])
+             (and m
+                  ((string->number (cadr m)) . < . (- (current-seconds)
+                                                      max-seconds)))))
+      (delete-trash (car l))
+      (loop (cdr l))]
+     [(max-packages . < . 1) #f]
+     [(not pkg-name) #f]
+     [else
+      (let loop ([n 0])
+        (define name (format "~a-~a-~a" (current-seconds) n pkg-name))
+        (define p (build-path trash-dir name))
+        (if (or (directory-exists? p)
+                (file-exists? p)
+                (link-exists? p))
+            (loop (add1 n))
+            p))])))
+
+(define (pkg-empty-trash #:list? [show-list? #f]
+                         #:quiet? [quiet? #t])
+  (cond
+   [show-list?
+    (define trash-dir (find-trash-dir))
+    (printf "Trash directory for ~s scope:\n  ~a\nContent:\n"
+            (current-pkg-scope)
+            trash-dir)
+    (define exists? (directory-exists? trash-dir))
+    (define l (if exists?
+                  (directory-list trash-dir)
+                  null))
+    (cond
+     [(not exists?)
+      (printf "  [does not exist]\n")]
+     [(null? l)
+      (printf "  [none]\n")]
+     [else
+      (for ([i (in-list l)])
+        (printf "  ~a\n" i))])]
+   [else
+    (parameterize ([current-pkg-trash-max-packages 0])
+      (select-trash-dest #t #:remove-printf (if quiet? void printf/flush)))
+    (void)]))