home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
m
/
me_cd25.zip
/
BOBSMUTT.ZIP
/
MAKEBACK.MUT
next >
Wrap
Text File
|
1992-05-11
|
5KB
|
200 lines
;; $Source: c:/lib/mutt/RCS/makeback.mut $
;; $Revision: 1.5 $
;; $Date: 1992/05/12 00:19:48 $
;; Bob Stocker Public Domain
(const BACKUP-CHAR '~') ;; Last character in "type" field
;; of the "backup" (i.e. previous
;; version) of a file.
;; NOTE: Changing these commands to fit other
;; operating systems may not be enough. For example,
;; the "mv" command on Unix systems may require
;; that both files be specified with pathnames. A
;; pathname for the second file is not allowed by
;; the MS-DOS "rename" command. Check code in which
;; these constants are used before running these
;; programs on a different operating system.
(const DELETE-COMMAND "del") ;; OS command to delete a file
(const RENAME-COMMAND "rename") ;; OS command to rename a file
;; Routines in this (defun) are highly operating
;; system dependent.
(defun
external-file-name (string fn)
;; Translates internal filename to exteranl
;; filename.
;; MS-DOS version -- translates '/' to '\'.
{ ;; BEGIN external-file-name
(int i l)
(string fname)
(fname (fn))
(l (length-of fname))
(for
(i 0)
(< i l)
(+= i 1)
(if
(== (extract-element fname i) '/')
{ ;; BEGIN / -> \
(insert-object fname i '\')
(remove-elements fname i 1)
} ;; END / -> \
)
)
(fname)
} ;; END external-file-name
)
;;
;; ================================================================
;;
(defun
make-backup-name (string fname)
;; Creates a new name for the previous version
;; of the file being edited.
{ ;; BEGIN make-backup-name
(int i imin l)
(string bname c)
(bname (fname))
(l (length-of bname))
(imin (- l 4))
(if (< imin 0) (imin 0))
(for
(i (- l 1))
(>= i imin)
(-= i 1)
{ ;; BEGIN scan for "."
(if
(== (extract-element bname i) ".")
{ ;; BEGIN found "."
(if
(== (- l i) 4)
(remove-elements bname (- l 1) 1)
)
(concat bname BACKUP-CHAR)
(done)
} ;; END found "."
)
} ;; END scan for .
)
(concat bname "." BACKUP-CHAR)
} ;; END make-backup-name
;;
;; ================================================================
;;
zap-path (string fname)
;; Deletes any path prefix on a filename.
{ ;; BEGIN zap-path
(int i l)
(string c only-name)
(only-name fname)
(l (length-of fname))
(for
(i (- l 1))
(>= i 0)
(-= i 1)
{ ;; BEGIN scan for /:\
(c (extract-element fname i))
(if
(or
(== c '/')
(== c '\')
(== c ':')
)
{ ;; BEGIN zap d:\pathname
(only-name
(extract-elements
fname
(+ i 1)
(- l i 1)
)
)
(break)
} ;; END zap d:\pathname
)
} ;; END scan for /:\
)
(only-name)
} ;; END zap-path
;;
;; ================================================================
;;
save-buffer-with-backup
;; Renames the previous version of the file before
;; saving the buffer.
{ ;; BEGIN save-buffer-with-backup
(string fname)
(string bname)
(int i l)
(fname (file-name (current-buffer)))
(l (length-of fname))
(if
(file-exists fname)
{ ;; BEGIN file exists
(bname (make-backup-name fname))
(if
(file-exists bname)
{ ;; BEGIN del
(msg "Deleting " bname)
(OS-filter
(concat
DELETE-COMMAND " "
(external-file-name bname)
)
)
} ;; END del
)
(msg "Renaming original to " bname)
(OS-filter
(concat
RENAME-COMMAND " "
(external-file-name fname)
" "
(zap-path bname)
)
)
} ;; END file exists
)
(save-buffer)
} ;; END save-buffer-with-backup
)
;; Programs in this (defun) may be useful for
;; debugging.
;; TEST (defun
;; TEST test-backup-name
;; TEST {
;; TEST (string fn) ;; BEGIN test-backup-name
;; TEST (ask-user)
;; TEST (fn (ask "File: "))
;; TEST (msg "File: " fn " Backup: " (make-backup-name fn))
;; TEST } ;; END test-backup-name
;; TEST ;;
;; TEST ;; ================================================================
;; TEST ;;
;; TEST test-external-file-name
;; TEST {
;; TEST (string fn) ;; BEGIN test-external-file-name
;; TEST (ask-user)
;; TEST (fn (ask "File: "))
;; TEST (msg "File: " fn " MS-DOS: " (external-file-name fn))
;; TEST } ;; END test-external-file-name
;; TEST ;;
;; TEST ;; ================================================================
;; TEST ;;
;; TEST test-zap-path
;; TEST {
;; TEST (string fn) ;; BEGIN test-zap-path
;; TEST (ask-user)
;; TEST (fn (ask "File: "))
;; TEST (msg "File: " fn " Zapped file: " (zap-path fn))
;; TEST } ;; END test-zap-path
;; TEST )