[Emacs-diffs] /srv/bzr/emacs/emacs-24 r108493: Replace the last use of the external vcdiff script

[Glenn Morris]

------------------------------------------------------------
revno: 108493
committer: Glenn Morris <address@hidden>
branch nick: trunk
timestamp: Tue 2012-06-05 20:29:10 -0400
message:
  Replace the last use of the external vcdiff script
  
  * lisp/vc/vc-sccs.el (vc-sccs-write-revision): New function.
  (vc-sccs-workfile-unchanged-p): Use vc-sccs-write-revision.
  (vc-sccs-diff): Replace use of the external vcdiff script.
modified:
  lisp/ChangeLog
  lisp/vc/vc-sccs.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-06-05 17:47:27 +0000
+++ b/lisp/ChangeLog    2012-06-06 00:29:10 +0000
@@ -1,3 +1,9 @@
+2012-06-06  Glenn Morris  <address@hidden>
+
+       * vc/vc-sccs.el (vc-sccs-write-revision): New function.
+       (vc-sccs-workfile-unchanged-p): Use vc-sccs-write-revision.
+       (vc-sccs-diff): Replace use of the external vcdiff script.
+
 2012-06-05  Glenn Morris  <address@hidden>
 
        * ledit.el: Move to obsolete/.

=== modified file 'lisp/vc/vc-sccs.el'
--- a/lisp/vc/vc-sccs.el        2012-06-05 01:05:51 +0000
+++ b/lisp/vc/vc-sccs.el        2012-06-06 00:29:10 +0000
@@ -23,10 +23,6 @@
 
 ;;; Commentary:
 
-;; Proper function of the SCCS diff commands requires the shellscript vcdiff
-;; to be installed somewhere on Emacs's path for executables.
-;;
-
 ;;; Code:
 
 (eval-when-compile
@@ -37,15 +33,13 @@
 ;;;
 
 ;; ;; Maybe a better solution is to not use "get" but "sccs get".
-;; (defcustom vc-sccs-path
-;;   (let ((path ()))
-;;     (dolist (dir '("/usr/sccs" "/usr/lib/sccs" "/usr/libexec/sccs"))
-;;       (if (file-directory-p dir)
-;;           (push dir path)))
-;;     path)
-;;   "List of extra directories to search for SCCS commands."
-;;   :type '(repeat directory)
-;;   :group 'vc)
+;; ;; Note for GNU CSSC, you can parse sccs -V to get the libexec path.
+;;  (defcustom vc-sccs-path
+;;    (prune-directory-list '("/usr/ccs/bin" "/usr/sccs" "/usr/lib/sccs"
+;;                        "/usr/libexec/sccs"))
+;;    "List of extra directories to search for SCCS commands."
+;;    :type '(repeat directory)
+;;    :group 'vc)
 
 (defgroup vc-sccs nil
   "VC SCCS backend."
@@ -186,17 +180,22 @@
     (vc-insert-file (vc-name file) "^\001e\n\001[^s]")
     (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1)))
 
+;; Cf vc-sccs-find-revision.
+(defun vc-sccs-write-revision (file outfile &optional rev)
+  "Write the SCCS version of input file FILE to output file OUTFILE.
+Optional string REV is a revision."
+  (with-temp-buffer
+    (apply 'vc-sccs-do-command t 0 "get" (vc-name file)
+          (append '("-s" "-p" "-k") ; -k: no keyword expansion
+                  (if rev (list (concat "-r" rev)))))
+    (write-region nil nil outfile nil 'silent)))
+
 (defun vc-sccs-workfile-unchanged-p (file)
   "SCCS-specific implementation of `vc-workfile-unchanged-p'."
   (let ((tempfile (make-temp-file "vc-sccs")))
     (unwind-protect
        (progn
-         (with-temp-buffer
-           ;; Cf vc-sccs-find-revision.
-           (vc-sccs-do-command t 0 "get" (vc-name file)
-                               "-s" "-p" "-k" ; no keyword expansion
-                               (concat "-r" (vc-working-revision file)))
-           (write-region nil nil tempfile nil 'silent))
+         (vc-sccs-write-revision file tempfile (vc-working-revision file))
          (zerop (vc-do-command "*vc*" 1 "cmp" file tempfile)))
       (delete-file tempfile))))
 
@@ -354,17 +353,75 @@
   (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-name files))
   (when limit 'limit-unsupported))
 
+;; FIXME use sccsdiff if present?
 (defun vc-sccs-diff (files &optional oldvers newvers buffer)
   "Get a difference report using SCCS between two filesets."
   (setq files (vc-expand-dirs files))
   (setq oldvers (vc-sccs-lookup-triple (car files) oldvers))
   (setq newvers (vc-sccs-lookup-triple (car files) newvers))
-  (apply 'vc-do-command (or buffer "*vc-diff*")
-        1 "vcdiff" (mapcar 'vc-name (vc-expand-dirs files))
-         (append (list "-q"
-                       (and oldvers (concat "-r" oldvers))
-                       (and newvers (concat "-r" newvers)))
-                 (vc-switches 'SCCS 'diff))))
+  (or buffer (setq buffer "*vc-diff*"))
+  ;; We have to reimplement pieces of vc-do-command, because
+  ;; we want to run multiple external commands, and only do the setup
+  ;; and exit pieces once.
+  (save-current-buffer
+    (unless (or (eq buffer t)
+               (and (stringp buffer) (string= (buffer-name) buffer))
+               (eq buffer (current-buffer)))
+      (vc-setup-buffer buffer))
+    (let* ((fake-flags (append (vc-switches 'SCCS 'diff)
+                              (if oldvers (list (concat " -r" oldvers)))
+                              (if newvers (list (concat " -r" newvers)))))
+          (fake-command
+           (format "diff%s %s"
+                   (if fake-flags
+                       (concat " " (mapconcat 'identity fake-flags " "))
+                     "")
+                   (vc-delistify files)))
+          (status 0)
+          (oldproc (get-buffer-process (current-buffer))))
+    (when vc-command-messages
+      (message "Running %s in foreground..." fake-command))
+    (if oldproc (delete-process oldproc))
+    (dolist (file files)
+      (let ((oldfile (make-temp-file "vc-sccs"))
+           newfile)
+       (unwind-protect
+           (progn
+             (vc-sccs-write-revision file oldfile oldvers)
+             (if newvers
+                 (vc-sccs-write-revision file (setq newfile
+                                                    (make-temp-file "vc-sccs"))
+                                         newvers))
+             (let* ((inhibit-read-only t)
+                    (buffer-undo-list t)
+                    (process-environment
+                     (cons "LC_MESSAGES=C" process-environment))
+                    (w32-quote-process-args t)
+                    (this-status
+                     (apply 'process-file "diff" nil t nil
+                            (append (vc-switches 'SCCS 'diff)
+                                    (list oldfile
+                                          (or newfile
+                                              (file-relative-name file)))))))
+               (or (integerp this-status) (setq status 'error))
+               (and (integerp status)
+                    (> this-status status)
+                    (setq status this-status))))
+         (delete-file oldfile)
+         (if newfile (delete-file newfile)))))
+    (when (or (not (integerp status)) (> status 1))
+      (unless (eq ?\s (aref (buffer-name (current-buffer)) 0))
+       (pop-to-buffer (current-buffer))
+       (goto-char (point-min))
+       (shrink-window-if-larger-than-buffer))
+      (error "Running %s...FAILED (%s)" fake-command
+            (if (integerp status) (format "status %d" status) status)))
+    (when vc-command-messages
+      (message "Running %s...OK = %d" fake-command status))
+    ;; Should we pretend we ran sccsdiff instead?
+    ;; This might not actually be a valid diff command.
+    (run-hook-with-args 'vc-post-command-functions "diff" files fake-flags)
+    status)))
 
 
 ;;;