home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / runtime / pathnm.scm < prev    next >
Text File  |  2001-05-12  |  21KB  |  619 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: pathnm.scm,v 14.34 2001/05/12 19:40:09 cph Exp $
  4.  
  5. Copyright (c) 1988-2001 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
  20. USA.
  21. |#
  22.  
  23. ;;;; Pathnames
  24. ;;; package: (runtime pathname)
  25.  
  26. (declare (usual-integrations))
  27.  
  28. #|
  29.  
  30. When examining pathname components, programs must be prepared to
  31. encounter any of the following situations:
  32.  
  33. * The host can be a host object.
  34.  
  35. * Any component except the host can be #F, which means the component
  36.   has not been specified.
  37.  
  38. * Any component except the can be 'UNSPECIFIC, which means the
  39.   component has no meaning in this particular pathname.
  40.  
  41. * The device, name, and type can be non-null strings.
  42.  
  43. * The directory can be a non-empty list of non-null strings and
  44.   symbols, whose first element is either 'ABSOLUTE or 'RELATIVE.
  45.  
  46. * The version can be any symbol or any positive exact integer.  The
  47.   symbol 'NEWEST refers to the largest version number that already
  48.   exists in the file system when reading, overwriting, appending,
  49.   superseding, or directory-listing an existing file; it refers to the
  50.   smallest version number greater than any existing version number
  51.   when creating a new file.
  52.  
  53. When examining wildcard components of a wildcard pathname, programs
  54. must be prepared to encounter any of the following additional values
  55. in any component (except the host) or any element of a list that is
  56. the directory component:
  57.  
  58. * The symbol 'WILD, which matches anything.
  59.  
  60. * A string containing implementation-dependent special wildcard
  61.   characters.
  62.  
  63. * Any object, representing an implementation-dependent wildcard
  64.   pattern.
  65.  
  66. When constructing a pathname from components, programs must follow
  67. these rules:
  68.  
  69. * Any component may be #F.  Specifying #F for the host results in
  70.   using a default host rather than an actual #F value.
  71.  
  72. * The host may be a host object.
  73.  
  74. * The device, name, and type may be strings.  There are
  75.   implementation-dependent limits on the number and type of characters
  76.   in these strings.  A plausible assumption is that letters (of a
  77.   single case) and digits are acceptable to most file system.
  78.  
  79. * The directory may be a list of strings and symbols whose first
  80.   element is either 'ABSOLUTE or 'RELATIVE.  There are
  81.   implementation-dependent limits on the length and contents of the
  82.   list.
  83.  
  84. * The version may be 'NEWEST.
  85.  
  86. * Any component may be taken from the corresponding component of
  87.   another pathname.  When the two pathnames are for different file
  88.   systems, an appropriate translation occurs.  If no meaningful
  89.   translation is possible, an error is signalled.
  90.  
  91. * When constructing a wildcard pathname, the name, type, or version
  92.   may be 'WILD, which matches anything.
  93.  
  94. |#
  95.  
  96. (define-structure (pathname
  97.            (type vector)
  98.            (named ((ucode-primitive string->symbol)
  99.                "#[(runtime pathname)pathname]"))
  100.            (constructor %make-pathname)
  101.            (conc-name %pathname-)
  102.            (print-procedure
  103.             (standard-unparser-method 'PATHNAME
  104.               (lambda (pathname port)
  105.             (write-char #\space port)
  106.             (write (->namestring pathname) port)))))
  107.   (host #f read-only #t)
  108.   (device #f read-only #t)
  109.   (directory #f read-only #t)
  110.   (name #f read-only #t)
  111.   (type #f read-only #t)
  112.   (version #f read-only #t))
  113.  
  114. (define (->pathname object)
  115.   (pathname-arg object #f '->PATHNAME))
  116.  
  117. (define (pathname-arg object defaults operator)
  118.   (cond ((pathname? object) object)
  119.     ((string? object) (parse-namestring object #f defaults))
  120.     (else (error:wrong-type-argument object "pathname" operator))))
  121.  
  122. (define (make-pathname host device directory name type version)
  123.   (let ((host (if host (guarantee-host host 'MAKE-PATHNAME) local-host)))
  124.     ((host-type/operation/make-pathname (host/type host))
  125.      host device directory name type version)))
  126.  
  127. (define (pathname-host pathname)
  128.   (%pathname-host (->pathname pathname)))
  129.  
  130. (define (pathname-device pathname)
  131.   (%pathname-device (->pathname pathname)))
  132.  
  133. (define (pathname-directory pathname)
  134.   (%pathname-directory (->pathname pathname)))
  135.  
  136. (define (pathname-name pathname)
  137.   (%pathname-name (->pathname pathname)))
  138.  
  139. (define (pathname-type pathname)
  140.   (%pathname-type (->pathname pathname)))
  141.  
  142. (define (pathname-version pathname)
  143.   (%pathname-version (->pathname pathname)))
  144.  
  145. (define (pathname-end-of-line-string pathname)
  146.   (let ((pathname (->pathname pathname)))
  147.     ((host-type/operation/end-of-line-string
  148.       (host/type (%pathname-host pathname)))
  149.      pathname)))
  150.  
  151. (define (pathname=? x y)
  152.   (let ((x (->pathname x))
  153.     (y (->pathname y)))
  154.     (and (host=? (%pathname-host x) (%pathname-host y))
  155.      (equal? (%pathname-device x) (%pathname-device y))
  156.      (equal? (%pathname-directory x) (%pathname-directory y))
  157.      (equal? (%pathname-name x) (%pathname-name y))
  158.      (equal? (%pathname-type x) (%pathname-type y))
  159.      (equal? (%pathname-version x) (%pathname-version y)))))
  160.  
  161. (define (pathname-absolute? pathname)
  162.   (let ((directory (pathname-directory pathname)))
  163.     (and (pair? directory)
  164.      (eq? (car directory) 'ABSOLUTE))))
  165.  
  166. (define (pathname-wild? pathname)
  167.   (let ((pathname (->pathname pathname)))
  168.     ((host-type/operation/pathname-wild?
  169.       (host/type (%pathname-host pathname)))
  170.      pathname)))
  171.  
  172. (define (directory-pathname? pathname)
  173.   (let ((pathname (->pathname pathname)))
  174.     ((host-type/operation/directory-pathname?
  175.       (host/type (%pathname-host pathname)))
  176.      pathname)))
  177.  
  178. (define (pathname-simplify pathname)
  179.   (let ((pathname (->pathname pathname)))
  180.     ((host-type/operation/pathname-simplify
  181.       (host/type (%pathname-host pathname)))
  182.      pathname)))
  183.  
  184. (define (directory-pathname pathname)
  185.   (let ((pathname (->pathname pathname)))
  186.     ((host-type/operation/directory-pathname
  187.       (host/type (%pathname-host pathname)))
  188.      pathname)))
  189.  
  190. (define (file-pathname pathname)
  191.   (let ((pathname (->pathname pathname)))
  192.     ((host-type/operation/file-pathname
  193.       (host/type (%pathname-host pathname)))
  194.      pathname)))
  195.  
  196. (define (pathname-as-directory pathname)
  197.   (let ((pathname (->pathname pathname)))
  198.     ((host-type/operation/pathname-as-directory
  199.       (host/type (%pathname-host pathname)))
  200.      pathname)))
  201.  
  202. (define (directory-pathname-as-file pathname)
  203.   (let ((pathname (->pathname pathname)))
  204.     ((host-type/operation/directory-pathname-as-file
  205.       (host/type (%pathname-host pathname)))
  206.      pathname)))
  207.  
  208. (define (pathname-new-device pathname device)
  209.   (let ((pathname (->pathname pathname)))
  210.     (%make-pathname (%pathname-host pathname)
  211.             device
  212.             (%pathname-directory pathname)
  213.             (%pathname-name pathname)
  214.             (%pathname-type pathname)
  215.             (%pathname-version pathname))))
  216.  
  217. (define (pathname-new-directory pathname directory)
  218.   (let ((pathname (->pathname pathname)))
  219.     (%make-pathname (%pathname-host pathname)
  220.             (%pathname-device pathname)
  221.             directory
  222.             (%pathname-name pathname)
  223.             (%pathname-type pathname)
  224.             (%pathname-version pathname))))
  225.  
  226. (define (pathname-new-name pathname name)
  227.   (let ((pathname (->pathname pathname)))
  228.     (%make-pathname (%pathname-host pathname)
  229.             (%pathname-device pathname)
  230.             (%pathname-directory pathname)
  231.             name
  232.             (%pathname-type pathname)
  233.             (%pathname-version pathname))))
  234.  
  235. (define (pathname-new-type pathname type)
  236.   (let ((pathname (->pathname pathname)))
  237.     (%make-pathname (%pathname-host pathname)
  238.             (%pathname-device pathname)
  239.             (%pathname-directory pathname)
  240.             (%pathname-name pathname)
  241.             type
  242.             (%pathname-version pathname))))
  243.  
  244. (define (pathname-new-version pathname version)
  245.   (let ((pathname (->pathname pathname)))
  246.     (%make-pathname (%pathname-host pathname)
  247.             (%pathname-device pathname)
  248.             (%pathname-directory pathname)
  249.             (%pathname-name pathname)
  250.             (%pathname-type pathname)
  251.             version)))
  252.  
  253. (define (pathname-default-device pathname device)
  254.   (let ((pathname (->pathname pathname)))
  255.     (if (%pathname-device pathname)
  256.     pathname
  257.     (pathname-new-device pathname device))))
  258.  
  259. (define (pathname-default-directory pathname directory)
  260.   (let ((pathname (->pathname pathname)))
  261.     (if (%pathname-directory pathname)
  262.     pathname
  263.     (pathname-new-directory pathname directory))))
  264.  
  265. (define (pathname-default-name pathname name)
  266.   (let ((pathname (->pathname pathname)))
  267.     (if (%pathname-name pathname)
  268.     pathname
  269.     (pathname-new-name pathname name))))
  270.  
  271. (define (pathname-default-type pathname type)
  272.   (let ((pathname (->pathname pathname)))
  273.     (if (%pathname-type pathname)
  274.     pathname
  275.     (pathname-new-type pathname type))))
  276.  
  277. (define (pathname-default-version pathname version)
  278.   (let ((pathname (->pathname pathname)))
  279.     (if (%pathname-version pathname)
  280.     pathname
  281.     (pathname-new-version pathname version))))
  282.  
  283. (define (pathname-default pathname device directory name type version)
  284.   (let ((pathname (->pathname pathname)))
  285.     (%make-pathname (%pathname-host pathname)
  286.             (or (%pathname-device pathname) device)
  287.             (or (%pathname-directory pathname) directory)
  288.             (or (%pathname-name pathname) name)
  289.             (or (%pathname-type pathname) type)
  290.             (or (%pathname-version pathname) version))))
  291.  
  292. ;;;; Pathname Syntax
  293.  
  294. (define (parse-namestring namestring #!optional host defaults)
  295.   (let ((host
  296.      (if (and (not (default-object? host)) host)
  297.          (begin
  298.            (if (not (host? host))
  299.            (error:wrong-type-argument host "host" 'PARSE-NAMESTRING))
  300.            host)
  301.          (pathname-host
  302.           (if (and (not (default-object? defaults)) defaults)
  303.           defaults
  304.           *default-pathname-defaults*)))))
  305.     (cond ((string? namestring)
  306.        ((host-type/operation/parse-namestring (host/type host))
  307.         namestring host))
  308.       ((pathname? namestring)
  309.        (if (not (host=? host (pathname-host namestring)))
  310.            (error:bad-range-argument namestring 'PARSE-NAMESTRING))
  311.        namestring)
  312.       (else
  313.        (error:wrong-type-argument namestring "namestring"
  314.                       'PARSE-NAMESTRING)))))
  315.  
  316. (define (->namestring pathname)
  317.   (let ((pathname (->pathname pathname)))
  318.     (string-append (host-namestring pathname)
  319.            (pathname->namestring pathname))))
  320.  
  321. (define (file-namestring pathname)
  322.   (pathname->namestring (file-pathname pathname)))
  323.  
  324. (define (directory-namestring pathname)
  325.   (pathname->namestring (directory-pathname pathname)))
  326.  
  327. (define (host-namestring pathname)
  328.   (let ((host (host/name (pathname-host pathname))))
  329.     (if host
  330.     (string-append host "::")
  331.     "")))
  332.  
  333. (define (enough-namestring pathname #!optional defaults)
  334.   (let ((defaults
  335.       (if (and (not (default-object? defaults)) defaults)
  336.           (->pathname defaults)
  337.           *default-pathname-defaults*)))
  338.     (let ((pathname (enough-pathname pathname defaults)))
  339.       (let ((namestring (pathname->namestring pathname)))
  340.     (if (host=? (%pathname-host pathname) (%pathname-host defaults))
  341.         namestring
  342.         (string-append (host-namestring pathname) namestring))))))
  343.  
  344. (define (pathname->namestring pathname)
  345.   ((host-type/operation/pathname->namestring
  346.     (host/type (%pathname-host pathname)))
  347.    pathname))
  348.  
  349. ;;;; Pathname Merging
  350.  
  351. (define *default-pathname-defaults*)
  352.  
  353. (define (merge-pathnames pathname #!optional defaults default-version)
  354.   (let* ((defaults
  355.        (if (and (not (default-object? defaults)) defaults)
  356.            (->pathname defaults)
  357.            *default-pathname-defaults*))
  358.      (pathname (pathname-arg pathname defaults 'MERGE-PATHNAMES)))
  359.     (make-pathname
  360.      (or (%pathname-host pathname) (%pathname-host defaults))
  361.      (or (%pathname-device pathname)
  362.      (and (%pathname-host pathname)
  363.           (host=? (%pathname-host pathname) (%pathname-host defaults))
  364.           (%pathname-device defaults)))
  365.      (let ((directory (%pathname-directory pathname))
  366.        (default (%pathname-directory defaults)))
  367.        (cond ((not directory)
  368.           default)
  369.          ((and (pair? directory)
  370.            (eq? (car directory) 'RELATIVE)
  371.            (pair? default))
  372.           (append default (cdr directory)))
  373.          (else
  374.           directory)))
  375.      (or (%pathname-name pathname) (%pathname-name defaults))
  376.      (or (%pathname-type pathname) (%pathname-type defaults))
  377.      (or (%pathname-version pathname)
  378.      (and (not (%pathname-name pathname)) (%pathname-version defaults))
  379.      (if (default-object? default-version)
  380.          'NEWEST
  381.          default-version)))))
  382.  
  383. (define (enough-pathname pathname #!optional defaults)
  384.   (let* ((defaults
  385.        (if (and (not (default-object? defaults)) defaults)
  386.            (->pathname defaults)
  387.            *default-pathname-defaults*))
  388.      (pathname (pathname-arg pathname defaults 'ENOUGH-PATHNAME)))
  389.     (let ((usual
  390.        (lambda (component default)
  391.          (and (or (symbol? component)
  392.               (not (equal? component default)))
  393.           component))))
  394.       (make-pathname
  395.        (and (or (symbol? (%pathname-host pathname))
  396.         (not (host=? (%pathname-host pathname)
  397.                  (%pathname-host defaults))))
  398.         (%pathname-host pathname))
  399.        (let ((device (%pathname-device pathname)))
  400.      (and (or (symbol? device)
  401.           (not (equal? device (%pathname-device defaults)))
  402.           (not (host=? (%pathname-host pathname)
  403.                    (%pathname-host defaults))))
  404.           device))
  405.        (let ((directory (%pathname-directory pathname))
  406.          (default (%pathname-directory defaults)))
  407.      (if (or (not directory)
  408.          (symbol? directory)
  409.          (not (eq? (car directory) (car default)))
  410.          ;; Detect the case where directory starts with "//"
  411.          ;; and default does not, or vice versa.  This is a
  412.          ;; kludge to make network devices work properly in
  413.          ;; DOS-like pathnames.
  414.          (and (eq? (car directory) 'ABSOLUTE)
  415.               (not (boolean=? (and (pair? (cdr directory))
  416.                        (equal? (cadr directory) ""))
  417.                       (and (pair? (cdr default))
  418.                        (equal? (cadr default) ""))))))
  419.          directory
  420.          (let loop
  421.          ((components (cdr directory)) (components* (cdr default)))
  422.            (cond ((null? components*)
  423.               (cons 'RELATIVE components))
  424.              ((and (not (null? components))
  425.                (equal? (car components) (car components*)))
  426.               (loop (cdr components) (cdr components*)))
  427.              (else
  428.               directory)))))
  429.        (usual (%pathname-name pathname) (%pathname-name defaults))
  430.        (usual (%pathname-type pathname) (%pathname-type defaults))
  431.        (let ((version (%pathname-version pathname)))
  432.      (and (or (symbol? version)
  433.           (not (equal? version (%pathname-version defaults)))
  434.           (%pathname-name pathname))
  435.           version))))))
  436.  
  437. ;;;; Host Abstraction
  438. ;;;  A lot of hair to make pathnames fasdumpable.
  439.  
  440. (define host-types)
  441. (define local-host)
  442.  
  443. (define-structure (host-type (conc-name host-type/))
  444.   (index #f read-only #t)
  445.   (name #f read-only #t)
  446.   (operation/parse-namestring #f read-only #t)
  447.   (operation/pathname->namestring #f read-only #t)
  448.   (operation/make-pathname #f read-only #t)
  449.   (operation/pathname-wild? #f read-only #t)
  450.   (operation/directory-pathname? #f read-only #t)
  451.   (operation/directory-pathname #f read-only #t)
  452.   (operation/file-pathname #f read-only #t)
  453.   (operation/pathname-as-directory #f read-only #t)
  454.   (operation/directory-pathname-as-file #f read-only #t)
  455.   (operation/pathname->truename #f read-only #t)
  456.   (operation/user-homedir-pathname #f read-only #t)
  457.   (operation/init-file-pathname #f read-only #t)
  458.   (operation/pathname-simplify #f read-only #t)
  459.   (operation/end-of-line-string #f read-only #t))
  460.  
  461. (define-structure (host (type vector)
  462.             (named ((ucode-primitive string->symbol)
  463.                 "#[(runtime pathname)host]"))
  464.             (constructor %make-host)
  465.             (conc-name host/))
  466.   (type-index #f read-only #t)
  467.   (name #f read-only #t))
  468.  
  469. (define (make-host type name)
  470.   (%make-host (host-type/index type) name))
  471.  
  472. (define (host/type host)
  473.   (vector-ref host-types (host/type-index host)))
  474.  
  475. (define (host/type-name host)
  476.   (host-type/name (host/type host)))
  477.  
  478. (define (host=? x y)
  479.   (and (= (host/type-index x) (host/type-index y))
  480.        (equal? (host/name x) (host/name y))))
  481.  
  482. (define (guarantee-host host operation)
  483.   (if (not (host? host)) (error:wrong-type-argument host "host" operation))
  484.   host)
  485.  
  486. ;;;; File System Stuff
  487.  
  488. (define (->truename pathname)
  489.   (let ((pathname (merge-pathnames pathname)))
  490.     ((host-type/operation/pathname->truename
  491.       (host/type (%pathname-host pathname)))
  492.      pathname)))
  493.  
  494. (define (user-homedir-pathname #!optional host)
  495.   (let ((host
  496.      (if (and (not (default-object? host)) host)
  497.          (guarantee-host host 'USER-HOMEDIR-PATHNAME)
  498.          local-host)))
  499.     ((host-type/operation/user-homedir-pathname (host/type host)) host)))
  500.  
  501. (define (init-file-pathname #!optional host)
  502.   (let ((host
  503.      (if (and (not (default-object? host)) host)
  504.          (guarantee-host host 'INIT-FILE-PATHNAME)
  505.          local-host)))
  506.     ((host-type/operation/init-file-pathname (host/type host)) host)))
  507.  
  508. (define (system-library-pathname pathname)
  509.   (let ((try-directory
  510.      (lambda (directory)
  511.        (let ((pathname (merge-pathnames pathname directory)))
  512.          (and (file-exists? pathname)
  513.           pathname))))
  514.     (loser
  515.      (lambda ()
  516.        (system-library-pathname
  517.         (->pathname
  518.          (error:file-operation pathname
  519.                    "find"
  520.                    "file"
  521.                    "no such file in system library path"
  522.                    system-library-pathname
  523.                    (list pathname)))))))
  524.     (if (pathname-absolute? pathname)
  525.     (if (file-exists? pathname) pathname (loser))
  526.     (let loop ((directories library-directory-path))
  527.       (if (null? directories)
  528.           (loser)
  529.           (or (try-directory (car directories))
  530.           (loop (cdr directories))))))))
  531.  
  532. (define library-directory-path)
  533.  
  534. (define (system-library-directory-pathname pathname)
  535.   (if (not pathname)
  536.       (let ((pathname
  537.          (list-search-positive library-directory-path file-directory?)))
  538.     (if (not pathname)
  539.         (error "can't find system library directory"))
  540.     (pathname-as-directory pathname))
  541.       (let loop ((directories library-directory-path))
  542.     (and (not (null? directories))
  543.          (let ((pathname (merge-pathnames pathname (car directories))))
  544.            (if (file-directory? pathname)
  545.            (pathname-as-directory pathname)
  546.            (loop (cdr directories))))))))
  547.  
  548. (define known-host-types
  549.   '((0 UNIX)
  550.     (1 DOS NT OS/2)
  551.     (2 VMS)))
  552.  
  553. (define (host-name->index name)
  554.   (let loop ((entries known-host-types))
  555.     (if (null? entries)
  556.     (error "Unknown host type:" name))
  557.     (if (memq name (cdar entries))
  558.     (caar entries)
  559.     (loop (cdr entries)))))
  560.  
  561. (define (host-index->name index)
  562.   (let ((entry (assv index known-host-types)))
  563.     (and entry
  564.      (cadr entry))))
  565.  
  566. (define available-host-types
  567.   '())
  568.  
  569. (define (host-name->type name)
  570.   (host-index->type (host-name->index name)))
  571.  
  572. (define (host-index->type index)
  573.   (let ((entry (assv index available-host-types)))
  574.     (if (not entry)
  575.     (error "Missing host type for index:" index))
  576.     (cdr entry)))
  577.  
  578. (define (add-pathname-host-type! name constructor)
  579.   (let ((index (host-name->index name)))
  580.     (let ((host-type (constructor index))
  581.       (place (assv index available-host-types)))
  582.       (if place
  583.       (set-cdr! place host-type)
  584.       (begin
  585.         (set! available-host-types
  586.           (cons (cons index host-type)
  587.             available-host-types))
  588.         unspecific)))))
  589.  
  590. (define (make-unimplemented-host-type index)
  591.   (let ((name (or (host-index->name index) 'UNKNOWN)))
  592.     (let ((fail
  593.        (lambda arguments
  594.          (error "Unimplemented host type:" name arguments))))
  595.       (make-host-type index name fail fail fail fail fail fail fail fail fail
  596.               fail fail fail fail fail))))
  597.  
  598. (define (reset-package!)
  599.   (let ((host-type (host-name->type microcode-id/operating-system))
  600.     (n-types (+ (apply max (map car known-host-types)) 1)))
  601.     (let ((types (make-vector n-types #f)))
  602.       (for-each (lambda (type) (vector-set! types (car type) (cdr type)))
  603.         available-host-types)
  604.       (do ((index 0 (+ index 1)))
  605.       ((= index n-types))
  606.     (if (not (vector-ref types index))
  607.         (vector-set! types index (make-unimplemented-host-type index))))
  608.       (set! host-types types)
  609.       (set! local-host (make-host host-type #f))))
  610.   (set! *default-pathname-defaults*
  611.     (make-pathname local-host #f #f #f #f #f))
  612.   (set! library-directory-path
  613.     (map pathname-as-directory
  614.          (vector->list ((ucode-primitive microcode-library-path 0)))))
  615.   unspecific)
  616.  
  617. (define (initialize-package!)
  618.   (reset-package!)
  619.   (add-event-receiver! event:after-restore reset-package!))