procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Replace the last use of the external vcdiff script

Browse source 
* 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.
This commit is contained in:
Glenn Morris 2012-06-05 20:29:10 -04:00
parent 903a72b37a
commit 7a58f64d95
2 changed files with 88 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/ChangeLog
View file

@ -1,3 +1,9 @@
2012-06-06 Glenn Morris <rgm@gnu.org>
* 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 <rgm@gnu.org>
* ledit.el: Move to obsolete/.

107
lisp/vc/vc-sccs.el
View file

@ -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 @@ For a description of possible values, see `vc-check-master-templates'."
(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 @@ revert all subfiles."
(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)))
;;;