From: Taylor R. Campbell Date: Fri, 16 Jun 2006 17:55:27 +0000 (+0000) Subject: Implement Unix diff(1) front end. X-Git-Tag: 20090517-FFI~1008 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8883264fcfa078c9ec15098d345f861bc02d681c;p=mit-scheme.git Implement Unix diff(1) front end. New Edwin variables: diff-program New Edwin commands: diff (compare two files) diff-backup (compare buffer's file with its most recent backup) diff-buffer-with-file (compare buffer with its underlying file) diff-auto-save (compare buffer with its auto-save file) --- diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm index 47a7421b4..ccd6268c3 100644 --- a/v7/src/edwin/decls.scm +++ b/v7/src/edwin/decls.scm @@ -1,8 +1,10 @@ #| -*-Scheme-*- -$Id: decls.scm,v 1.73 2003/02/14 18:28:11 cph Exp $ +$Id: decls.scm,v 1.74 2006/06/16 17:55:27 riastradh Exp $ -Copyright (c) 1989-2001 Massachusetts Institute of Technology +Copyright 1989,1990,1991,1992,1993,1994 Massachusetts Institute of Technology +Copyright 1995,1996,1997,1998,1999,2000 Massachusetts Institute of Technology +Copyright 2001,2006 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -214,6 +216,7 @@ USA. "txtprp" "undo" "unix" + "diff" "vc" "verilog" "vhdl" diff --git a/v7/src/edwin/diff.scm b/v7/src/edwin/diff.scm new file mode 100644 index 000000000..6f676fe1a --- /dev/null +++ b/v7/src/edwin/diff.scm @@ -0,0 +1,147 @@ +#| -*-Scheme-*- + +$Id: diff.scm,v 1.1 2006/06/16 17:55:27 riastradh Exp $ + +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. + +(declare (usual-integrations)) + +(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" + (list (buffer-pathname (selected-buffer)))))) + (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 pathname + (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 pathname + (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 pathname receiver) + (select-buffer + (if (buffer-modified? 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))) + (receiver 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)) diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr index 1cb27a5f5..0cce6b515 100644 --- a/v7/src/edwin/edwin.ldr +++ b/v7/src/edwin/edwin.ldr @@ -1,10 +1,10 @@ #| -*-Scheme-*- -$Id: edwin.ldr,v 1.76 2005/11/30 04:52:52 cph Exp $ +$Id: edwin.ldr,v 1.77 2006/06/16 17:55:27 riastradh Exp $ Copyright 1989,1990,1991,1992,1993,1994 Massachusetts Institute of Technology Copyright 1995,1996,1997,1998,1999,2000 Massachusetts Institute of Technology -Copyright 2001,2005 Massachusetts Institute of Technology +Copyright 2001,2005,2006 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -250,6 +250,7 @@ USA. (load "tagutl" (->environment '(EDWIN TAGS))) (load "texcom" environment) (load "htmlmode" environment) + (load "diff" (->environment '(EDWIN DIFF))) (load "rcsparse" (->environment '(EDWIN RCS-PARSE))) (load "vc" (->environment '(EDWIN VC))) (load "wincom" environment) diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index 2709519ff..ec660322f 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.pkg,v 1.294 2006/06/12 20:46:28 riastradh Exp $ +$Id: edwin.pkg,v 1.295 2006/06/16 17:55:27 riastradh Exp $ Copyright 1989,1990,1991,1992,1993,1994 Massachusetts Institute of Technology Copyright 1995,1996,1997,1998,1999,2000 Massachusetts Institute of Technology @@ -1426,6 +1426,18 @@ USA. (export (edwin screen os2-screen) update-os2-screen-names!)))) +(define-package (edwin diff) + (files "diff") + (parent (edwin)) + (export (edwin) + diff-to-buffer + edwin-command$diff + edwin-command$diff-auto-save + edwin-command$diff-backup + edwin-command$diff-buffer-with-file + edwin-variable$diff-program + edwin-variable$diff-switches)) + (define-package (edwin vc) (files "vc") (parent (edwin)) @@ -1443,7 +1455,6 @@ USA. edwin-command$vc-version-diff edwin-command$vc-version-other-window edwin-mode$vc-log - edwin-variable$diff-switches edwin-variable$vc-checkin-hooks edwin-variable$vc-checkout-carefully edwin-variable$vc-command-messages diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm index 65df473fc..526957278 100644 --- a/v7/src/edwin/vc.scm +++ b/v7/src/edwin/vc.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: vc.scm,v 1.93 2006/06/12 04:19:43 cph Exp $ +$Id: vc.scm,v 1.94 2006/06/16 17:55:27 riastradh Exp $ Copyright 1994,1995,1996,1997,1998,2000 Massachusetts Institute of Technology Copyright 2001,2002,2003,2005,2006 Massachusetts Institute of Technology @@ -85,11 +85,6 @@ This can be overriden by giving a prefix argument to \\[vc-register]." "If true, display run messages from back-end commands." #f boolean?) - -(define-variable diff-switches - "A list of strings specifying switches to be be passed to diff." - '("-c") - list-of-strings?) (define-variable vc-checkin-hooks "An event distributor that is invoked after a checkin is done."