146 lines
5.5 KiB
Scheme
146 lines
5.5 KiB
Scheme
#| -*-Scheme-*-
|
||
|
||
This code is written by Taylor R. Campbell and placed in the Public
|
||
Domain. All warranties are disclaimed.
|
||
|
||
|#
|
||
|
||
;;;; Unix diff(1) wrapper
|
||
|
||
;;; There ought to be an accompanying diff major mode, with fancy
|
||
;;; bells & whistles for converting between unified and context diffs,
|
||
;;; like in GNU Emacs. Some day.
|
||
|
||
|
||
|
||
(define-variable diff-program
|
||
"The name of the diff program."
|
||
"diff"
|
||
string?)
|
||
|
||
(define-variable diff-switches
|
||
"A list of strings specifying switches to pass to the diff command."
|
||
'("-c")
|
||
(lambda (obj)
|
||
(list-of-type? obj string?)))
|
||
|
||
(define-command diff
|
||
"Display differences between files."
|
||
"fOld file\nfNew file" ;Icky interactive specification
|
||
(lambda (old-filename new-filename)
|
||
(select-buffer (diff-to-buffer old-filename new-filename))))
|
||
|
||
(define-command diff-backup
|
||
"Display differences between a file and its latest backup."
|
||
(lambda ()
|
||
(list (prompt-for-existing-file
|
||
"Diff with backup"
|
||
(cond ((buffer-pathname (selected-buffer))
|
||
=> list)
|
||
(else #f)))))
|
||
(lambda (filename)
|
||
(select-buffer
|
||
(diff-to-buffer (or (os/newest-backup filename)
|
||
(editor-error "No known backup for file: "
|
||
filename))
|
||
filename))))
|
||
|
||
(define-command diff-buffer-with-file
|
||
"Display differences between a buffer and its original file."
|
||
"bBuffer"
|
||
(lambda (buffer-name)
|
||
(let* ((buffer (find-buffer buffer-name #t))
|
||
(pathname (buffer-pathname buffer)))
|
||
(if (not (and pathname (file-exists? pathname)))
|
||
(editor-error "Buffer has no associated file."))
|
||
(diff-buffer buffer
|
||
(lambda (temporary-pathname)
|
||
;; PATHNAME is the buffer's usual storage on the
|
||
;; disk; TEMPORARY-PATHNAME contains the buffer's
|
||
;; current contents.
|
||
(diff-to-buffer pathname temporary-pathname))))))
|
||
|
||
(define-command diff-auto-save
|
||
"Display differences from a buffer to its auto-save file."
|
||
"bBuffer"
|
||
(lambda (buffer-name)
|
||
(let* ((buffer (find-buffer buffer-name #t))
|
||
(pathname (buffer-pathname buffer))
|
||
(auto-save (os/auto-save-pathname pathname buffer)))
|
||
(if (not (file-exists? auto-save))
|
||
(editor-error "Buffer has no auto-save file."))
|
||
(diff-buffer buffer
|
||
(lambda (temporary-pathname)
|
||
;; PATHNAME is irrelevant; TEMPORARY-PATHNAME
|
||
;; contains the buffer's current contents; and
|
||
;; AUTO-SAVE contains the auto-saved contents.
|
||
(diff-to-buffer temporary-pathname auto-save))))))
|
||
|
||
(define (diff-buffer buffer receiver)
|
||
(select-buffer
|
||
(call-with-temporary-file-pathname
|
||
(lambda (temporary-pathname)
|
||
(write-region (buffer-region buffer)
|
||
temporary-pathname
|
||
#f ;No message
|
||
#f) ;No line ending translation
|
||
(receiver temporary-pathname)))))
|
||
|
||
(define (diff-to-buffer old-filename new-filename #!optional buffer)
|
||
(let ((buffer (diff-to-buffer-argument buffer)))
|
||
(buffer-reset! buffer)
|
||
(set-buffer-major-mode! buffer (ref-mode-object fundamental))
|
||
(buffer-put! buffer 'REVERT-BUFFER-METHOD
|
||
(lambda (buffer do-not-auto-save? do-not-confirm?)
|
||
do-not-auto-save? do-not-confirm? ;ignore
|
||
(diff-to-buffer old-filename new-filename buffer)))
|
||
(execute-diff old-filename new-filename buffer)
|
||
(set-buffer-point! buffer (buffer-start buffer))
|
||
(set-buffer-read-only! buffer)
|
||
buffer))
|
||
|
||
(define (diff-to-buffer-argument buffer)
|
||
(cond ((default-object? buffer) (find-or-create-buffer "*Diff*"))
|
||
((string? buffer) (find-or-create-buffer buffer))
|
||
((buffer? buffer) buffer)
|
||
(else (error:wrong-type-argument buffer "buffer or string"
|
||
'DIFF-TO-BUFFER))))
|
||
|
||
(define (execute-diff old-filename new-filename buffer)
|
||
(let ((defaults (buffer-default-directory buffer)))
|
||
(let ((command
|
||
(make-diff-command old-filename new-filename defaults))
|
||
(output-mark
|
||
(mark-left-inserting-copy (buffer-start buffer))))
|
||
(insert-string (decorated-string-append "" " " "" command)
|
||
output-mark)
|
||
(insert-newline output-mark)
|
||
(let ((result (run-diff-process command defaults output-mark)))
|
||
(insert-diff-exit-remarks result output-mark)))))
|
||
|
||
(define (make-diff-command old-filename new-filename defaults)
|
||
(cons (ref-variable diff-program)
|
||
(append (ref-variable diff-switches)
|
||
(list (enough-namestring old-filename defaults)
|
||
(enough-namestring new-filename defaults)))))
|
||
|
||
(define (run-diff-process command defaults output-mark)
|
||
(apply run-synchronous-process
|
||
#f ; no input region
|
||
output-mark
|
||
defaults
|
||
#f ; not a pty
|
||
command))
|
||
|
||
(define (insert-diff-exit-remarks result output-mark)
|
||
(insert-newline output-mark)
|
||
(insert-string "Diff finished" output-mark)
|
||
(if (eqv? result 0) (insert-string " (no differences)" output-mark))
|
||
(insert-char #\. output-mark)
|
||
(insert-newline output-mark)
|
||
(insert-chars #\space 2 output-mark)
|
||
(insert-string (universal-time->global-ctime-string
|
||
(get-universal-time))
|
||
output-mark)
|
||
(insert-newline output-mark))
|