From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Fri, 31 Aug 2007 18:04:31 +0000 (+0000)
Subject: r11859: Canonicalize whitespace
X-Git-Tag: v0.3.2~1
X-Git-Url: http://git.kpe.io/?p=vcs-tree.git;a=commitdiff_plain;h=07ed07c71c97ed1741d2d7ff4d5244dcb6c70907

r11859: Canonicalize whitespace
---

diff --git a/getopt-excerpt.lisp b/getopt-excerpt.lisp
index d59efee..0f8ca64 100644
--- a/getopt-excerpt.lisp
+++ b/getopt-excerpt.lisp
@@ -3,7 +3,7 @@
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; Name:          getopt.lisp
-;;;; Purpose:       Excerpted from cl-getopt package 
+;;;; Purpose:       Excerpted from cl-getopt package
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Sep 2003
 ;;;;
@@ -33,28 +33,28 @@
 (defun decompose-arg (arg option-type)
   "Returns base-name,argument"
   (let ((start (ecase option-type
-		 (:long 2)
-		 (:short 1)))
-	(name-end (position #\= arg)))
+                 (:long 2)
+                 (:short 1)))
+        (name-end (position #\= arg)))
 
     (values (subseq arg start name-end)
-	    (when name-end (subseq arg (1+ name-end))))))
+            (when name-end (subseq arg (1+ name-end))))))
 
 (defun analyze-arg (arg)
   "Analyzes an argument. Returns option-type,base-name,argument"
   (let* ((option-type (cond ((is-short-option arg) :short)
-			    ((is-long-option arg) :long)
-			    (t :arg))))
+                            ((is-long-option arg) :long)
+                            (t :arg))))
     (if (or (eq option-type :short) (eq option-type :long))
-	(multiple-value-bind (base arg) (decompose-arg arg option-type)
-	  (values option-type base arg))
-	(values :arg arg nil))))
+        (multiple-value-bind (base arg) (decompose-arg arg option-type)
+          (values option-type base arg))
+        (values :arg arg nil))))
 
 
 (defun find-option (name options)
   "Find an option in option list. Handles using unique abbreviations"
   (let* ((option-names (mapcar #'car options))
-	 (pos (match-unique-abbreviation name option-names)))
+         (pos (match-unique-abbreviation name option-names)))
     (when pos
       (nth pos options))))
 
@@ -71,17 +71,17 @@
   "Returns position of ABBR in STRINGS. ABBR may be a unique abbreviation.
 Returns NIL if no match found."
   (let ((len (length abbr))
-	(matches nil))
+        (matches nil))
     (dotimes (i (length strings))
       (let* ((s (nth i strings))
-	     (l (length s)))
-	(cond
-	  ((= len l)
-	   (when (string= abbr s)
-	     (push (cons s i) matches)))
-	  ((< len l)
-	   (when (string= abbr (subseq s 0 len))
-	     (push (cons s i) matches))))))
+             (l (length s)))
+        (cond
+          ((= len l)
+           (when (string= abbr s)
+             (push (cons s i) matches)))
+          ((< len l)
+           (when (string= abbr (subseq s 0 len))
+             (push (cons s i) matches))))))
     (when (= 1 (length matches))
       (cdr (first matches)))))
 
@@ -106,31 +106,31 @@ opts is a list of option lists. The fields of the list are
       (setq finished-options t))
      (t
       (let ((arg (car pos)))
-	(multiple-value-bind (option-list option-type base-name argument)
-	    (match-option (car pos) options)
-	  (cond
-	    (option-list
-	     (cond
-	       (argument
-		(case (second option-list)
-		  (:none
-		   (push base-name errors))
-		  (t
-		   (push (cons base-name argument) out-opts))))
-	       ((null argument)
-		(if (and (eq :required (second option-list)) (null (cdr pos)))
-		    (push base-name errors)
-		    (if (or (is-short-option (second pos))
-			    (is-long-option (second pos)))
-			(if (eq :required (second option-list))
-			    (push base-name errors)
-			    (push (cons base-name (third option-list)) out-args))
-			(progn
-			  (push (cons base-name (second pos)) out-opts)
-			  (setq pos (cdr pos))))))))
-	    (t
-	     (if (or (eq :long option-type)
-		     (eq :short option-type))
-		 (push (nth-value 0 (decompose-arg arg option-type)) errors)
-	       (push arg out-args))))))))))
+        (multiple-value-bind (option-list option-type base-name argument)
+            (match-option (car pos) options)
+          (cond
+            (option-list
+             (cond
+               (argument
+                (case (second option-list)
+                  (:none
+                   (push base-name errors))
+                  (t
+                   (push (cons base-name argument) out-opts))))
+               ((null argument)
+                (if (and (eq :required (second option-list)) (null (cdr pos)))
+                    (push base-name errors)
+                    (if (or (is-short-option (second pos))
+                            (is-long-option (second pos)))
+                        (if (eq :required (second option-list))
+                            (push base-name errors)
+                            (push (cons base-name (third option-list)) out-args))
+                        (progn
+                          (push (cons base-name (second pos)) out-opts)
+                          (setq pos (cdr pos))))))))
+            (t
+             (if (or (eq :long option-type)
+                     (eq :short option-type))
+                 (push (nth-value 0 (decompose-arg arg option-type)) errors)
+               (push arg out-args))))))))))
 
diff --git a/kmrcl-excerpt.lisp b/kmrcl-excerpt.lisp
index 9a74e8c..d425d71 100644
--- a/kmrcl-excerpt.lisp
+++ b/kmrcl-excerpt.lisp
@@ -17,10 +17,10 @@
   (let ((lines '()))
     (with-open-file (in file :direction :input)
       (let ((eof (gensym)))
-	(do ((line (read-line in nil eof)
-		   (read-line in nil eof)))
-	    ((eq line eof))
-	  (push line lines)))
+        (do ((line (read-line in nil eof)
+                   (read-line in nil eof)))
+            ((eq line eof))
+          (push line lines)))
       (nreverse lines))))
 
 
@@ -35,9 +35,9 @@
 
 (defun flatten (lis)
   (cond ((atom lis) lis)
-	((listp (car lis))
-	 (append (flatten (car lis)) (flatten (cdr lis))))
-	(t (append (list (car lis)) (flatten (cdr lis))))))
+        ((listp (car lis))
+         (append (flatten (car lis)) (flatten (cdr lis))))
+        (t (append (list (car lis)) (flatten (cdr lis))))))
 
 (defun mklist (obj)
   "Make into list if atom"
@@ -46,49 +46,49 @@
 (defun directory-tree (filename)
   "Returns a tree of pathnames for sub-directories of a directory"
   (let* ((root (canonicalize-directory-name filename))
-	 (subdirs (loop for path in (directory
-				     (make-pathname :name :wild
-						    :type :wild
-						    :defaults root))
-			when (probe-directory path)
-			collect (canonicalize-directory-name path))))
+         (subdirs (loop for path in (directory
+                                     (make-pathname :name :wild
+                                                    :type :wild
+                                                    :defaults root))
+                        when (probe-directory path)
+                        collect (canonicalize-directory-name path))))
     (when (find nil subdirs)
       (error "~A" subdirs))
     (when (null root)
       (error "~A" root))
     (if subdirs
-	(cons root (mapcar #'directory-tree subdirs))
-	(if (probe-directory root)
-	    (list root)
-	    (error "root not directory ~A" root)))))
+        (cons root (mapcar #'directory-tree subdirs))
+        (if (probe-directory root)
+            (list root)
+            (error "root not directory ~A" root)))))
 
 
 (defun canonicalize-directory-name (filename)
   (flet ((un-unspecific (value)
-	   (if (eq value :unspecific) nil value)))
+           (if (eq value :unspecific) nil value)))
     (let* ((path (pathname filename))
-	   (name (un-unspecific (pathname-name path)))
-	   (type (un-unspecific (pathname-type path)))
-	   (new-dir
-	    (cond ((and name type) (list (concatenate 'string name "." type)))
-		  (name (list name))
-		  (type (list type))
-		  (t nil))))
+           (name (un-unspecific (pathname-name path)))
+           (type (un-unspecific (pathname-type path)))
+           (new-dir
+            (cond ((and name type) (list (concatenate 'string name "." type)))
+                  (name (list name))
+                  (type (list type))
+                  (t nil))))
       (if new-dir
-	  (make-pathname
-	   :directory (append (un-unspecific (pathname-directory path))
-			      new-dir)
-		    :name nil :type nil :version nil :defaults path)
-	  path))))
+          (make-pathname
+           :directory (append (un-unspecific (pathname-directory path))
+                              new-dir)
+                    :name nil :type nil :version nil :defaults path)
+          path))))
 
 
 (defun probe-directory (filename)
   (let ((path (canonicalize-directory-name filename)))
     #+allegro (excl:probe-directory path)
     #+clisp (values
-	     (ignore-errors
-	       (#+lisp=cl ext:probe-directory #-lisp=cl lisp:probe-directory
-			  path)))
+             (ignore-errors
+               (#+lisp=cl ext:probe-directory #-lisp=cl lisp:probe-directory
+                          path)))
     #+(or cmu scl) (eq :directory (unix:unix-file-kind (namestring path)))
     #+lispworks (lw:file-directory-p path)
     #+sbcl (eq :directory (sb-unix:unix-file-kind (namestring path)))
@@ -101,7 +101,7 @@
   (cond
    ((not (null dir))
     (when (and (typep dir 'logical-pathname)
-	       (translate-logical-pathname dir))
+               (translate-logical-pathname dir))
       (setq dir (translate-logical-pathname dir)))
     (when (stringp dir)
       (setq dir (parse-namestring dir)))
@@ -116,16 +116,16 @@
     (setq cl:*default-pathname-defaults* dir))
    (t
     (let ((dir
-	   #+allegro (excl:current-directory)
-	   #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
-	   #+(or cmu scl) (ext:default-directory)
-	   #+sbcl (sb-unix:posix-getcwd/)
-	   #+cormanlisp (ccl:get-current-directory)
-	   #+lispworks (hcl:get-working-directory)
-	   #+mcl (ccl:mac-default-directory)
-	   #-(or allegro clisp cmu scl cormanlisp mcl sbcl lispworks) (truename ".")))
+           #+allegro (excl:current-directory)
+           #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
+           #+(or cmu scl) (ext:default-directory)
+           #+sbcl (sb-unix:posix-getcwd/)
+           #+cormanlisp (ccl:get-current-directory)
+           #+lispworks (hcl:get-working-directory)
+           #+mcl (ccl:mac-default-directory)
+           #-(or allegro clisp cmu scl cormanlisp mcl sbcl lispworks) (truename ".")))
       (when (stringp dir)
-	(setq dir (parse-namestring dir)))
+        (setq dir (parse-namestring dir)))
       dir))))
 
 
@@ -154,16 +154,16 @@
   #+allegro (excl.osi:command-output cmd :directory directory :whole whole)
   #+sbcl
   (let* ((out (make-array '(0) :element-type 'character :fill-pointer 0
-			  :adjustable t))
-	 (err (make-array '(0) :element-type 'character :fill-pointer 0
-			  :adjustable t))
-	(status
-	 (sb-impl::process-exit-code
-	  (with-output-to-string (out-stream out)
-	    (with-output-to-string (err-stream err)
-	      (sb-ext:run-program
-	       "/bin/sh"
-	       (list  "-c" cmd)
-	       :input nil :output out-stream :error err-stream))))))
+                          :adjustable t))
+         (err (make-array '(0) :element-type 'character :fill-pointer 0
+                          :adjustable t))
+        (status
+         (sb-impl::process-exit-code
+          (with-output-to-string (out-stream out)
+            (with-output-to-string (err-stream err)
+              (sb-ext:run-program
+               "/bin/sh"
+               (list  "-c" cmd)
+               :input nil :output out-stream :error err-stream))))))
     (values out err status))
   )
diff --git a/main.lisp b/main.lisp
index a6cf82f..1490525 100644
--- a/main.lisp
+++ b/main.lisp
@@ -18,106 +18,106 @@
 (defun is-vcs-directory (x)
   (and (pathnamep x)
        (or
-	(string= "CVS" 
-		 (car (last (pathname-directory x))))
-	(string= ".svn" 
-		 (car (last (pathname-directory x)))))))
+        (string= "CVS"
+                 (car (last (pathname-directory x))))
+        (string= ".svn"
+                 (car (last (pathname-directory x)))))))
 
 (defun is-cvs-managed (dir)
   (probe-directory (merge-pathnames
-		    (make-pathname :directory '(:relative "CVS"))
-		    dir)))
+                    (make-pathname :directory '(:relative "CVS"))
+                    dir)))
 
 (defun is-svn-managed (dir)
   (probe-directory (merge-pathnames
-		    (make-pathname :directory '(:relative ".svn"))
-		    dir)))
+                    (make-pathname :directory '(:relative ".svn"))
+                    dir)))
 
 (defun filter-tree (tree)
   "Called for a directory tree. First argument is name of current tree.
 Returns a list of directories managed by CVS or SVN."
   (when (and (listp tree) (not (is-vcs-directory (car tree))))
     (let* ((managed-pair
-	    (cond
-	     ((find ".svn" (cdr tree)
-		    :key (lambda (x) (when (pathnamep (car x))
-				       (car (last (pathname-directory (car x))))))
-		    :test 'equal)
-	      (cons (car tree) :svn))
-	     ((find "CVS" (cdr tree) 
-		    :key (lambda (x) (when (pathnamep (car x))
-				       (car (last (pathname-directory (car x))))))
-		    :test 'equal)
-	      (cons (car tree) :cvs))))
-	   (managed (car managed-pair))
-	   (type (cdr managed-pair)))
+            (cond
+             ((find ".svn" (cdr tree)
+                    :key (lambda (x) (when (pathnamep (car x))
+                                       (car (last (pathname-directory (car x))))))
+                    :test 'equal)
+              (cons (car tree) :svn))
+             ((find "CVS" (cdr tree)
+                    :key (lambda (x) (when (pathnamep (car x))
+                                       (car (last (pathname-directory (car x))))))
+                    :test 'equal)
+              (cons (car tree) :cvs))))
+           (managed (car managed-pair))
+           (type (cdr managed-pair)))
       (let ((vcs-removed
-	     (do* ((pos (cdr tree) (cdr pos))
-		   (curr (car pos) (car pos))
-		   (res nil))
-		 ((null pos) (nreverse res))
-	       (when (and (not (is-vcs-directory (car curr)))
-			  (or (not managed)
-			      (not (is-managed-dir (car curr) managed type))))
-		 (push curr res)))))
-	(if vcs-removed
-	    (if managed
-		(cons managed (flatten 
-			       (delete-if #'null
-					  (mapcar 'filter-tree vcs-removed))))
-	      (flatten (delete-if #'null (mapcar 'filter-tree vcs-removed))))
-	  managed))
+             (do* ((pos (cdr tree) (cdr pos))
+                   (curr (car pos) (car pos))
+                   (res nil))
+                 ((null pos) (nreverse res))
+               (when (and (not (is-vcs-directory (car curr)))
+                          (or (not managed)
+                              (not (is-managed-dir (car curr) managed type))))
+                 (push curr res)))))
+        (if vcs-removed
+            (if managed
+                (cons managed (flatten
+                               (delete-if #'null
+                                          (mapcar 'filter-tree vcs-removed))))
+              (flatten (delete-if #'null (mapcar 'filter-tree vcs-removed))))
+          managed))
       )))
 
 (defun is-managed-dir (subdir dir type)
   (let* ((entries-path
-	  (merge-pathnames
-	   (ecase type
-	     (:svn 
-	      (make-pathname :name "entries" :type nil
-			     :directory '(:relative ".svn")))
-	     (:cvs 
-	      (make-pathname :name "Entries" :type nil
-			     :directory '(:relative "CVS"))))
-	   dir))
-	 (entries (read-file-to-strings entries-path))
-	 (dir-name (car (last (pathname-directory subdir))))
-	 (match (case type
-		  (:svn
-		   (concatenate 'string "name=\"" dir-name "\""))
-		  (:cvs
-		   (concatenate 'string "D/" dir-name "////")))))
+          (merge-pathnames
+           (ecase type
+             (:svn
+              (make-pathname :name "entries" :type nil
+                             :directory '(:relative ".svn")))
+             (:cvs
+              (make-pathname :name "Entries" :type nil
+                             :directory '(:relative "CVS"))))
+           dir))
+         (entries (read-file-to-strings entries-path))
+         (dir-name (car (last (pathname-directory subdir))))
+         (match (case type
+                  (:svn
+                   (concatenate 'string "name=\"" dir-name "\""))
+                  (:cvs
+                   (concatenate 'string "D/" dir-name "////")))))
     (case type
       (:svn
        (some (lambda (line) (string= match (string-trim-whitespace line)))
-	     entries))
+             entries))
       (:cvs
        (or
-	(some (lambda (line) (string= match (string-trim-whitespace line)))
-	      entries)
-	(is-cvs-managed subdir))))))
+        (some (lambda (line) (string= match (string-trim-whitespace line)))
+              entries)
+        (is-cvs-managed subdir))))))
 
 
 (defun process-vcs-directory (dir action options)
   (flet ((process (dir type-name)
-	   (let* ((vcs-cmd
-		   (ecase action
-		     (:update
-		      (format nil "~A update" type-name)) 
-		     (:status
-		      (format nil "~A status" type-name)) 
-		     (:commit
-		      (format nil "~A commit~A" type-name
-			      (aif (find "m" options :key #'car :test 'string=)
-				   (format nil " -m \"~A\"" (cdr it))
-				   "")))))
-		  (cmd (format nil "(cd ~A; ~A)" (namestring dir) vcs-cmd)))
-	     (format t "~A ~A:~%" vcs-cmd (namestring dir))
-	     (multiple-value-bind (output error status)
-		 (shell-command-output cmd :directory dir :whole t)
-	       (if (zerop status)
-		   (format t "~A~%" output)
-		   (format t "Exit status ~D: ~A ~A~%" status output error))))))
+           (let* ((vcs-cmd
+                   (ecase action
+                     (:update
+                      (format nil "~A update" type-name))
+                     (:status
+                      (format nil "~A status" type-name))
+                     (:commit
+                      (format nil "~A commit~A" type-name
+                              (aif (find "m" options :key #'car :test 'string=)
+                                   (format nil " -m \"~A\"" (cdr it))
+                                   "")))))
+                  (cmd (format nil "(cd ~A; ~A)" (namestring dir) vcs-cmd)))
+             (format t "~A ~A:~%" vcs-cmd (namestring dir))
+             (multiple-value-bind (output error status)
+                 (shell-command-output cmd :directory dir :whole t)
+               (if (zerop status)
+                   (format t "~A~%" output)
+                   (format t "Exit status ~D: ~A ~A~%" status output error))))))
     (cond
       ((is-cvs-managed dir)
        (process dir "cvs"))
@@ -125,7 +125,7 @@ Returns a list of directories managed by CVS or SVN."
       (process dir "svn"))
      (t
       (format *error-output*
-	      "INTERAL ERROR: not a version control system directory ~A" dir)
+              "INTERAL ERROR: not a version control system directory ~A" dir)
       (quit 1)))))
 
 (defvar *progname* "")
@@ -134,10 +134,10 @@ Returns a list of directories managed by CVS or SVN."
   (format *error-output* "usage: ~A action [OPTIONS]~%" *progname*)
   (if msg
       (progn
-	(apply #'format *error-output* msg msg-args)
-	(write-char #\Newline *error-output*))
+        (apply #'format *error-output* msg msg-args)
+        (write-char #\Newline *error-output*))
       (format *error-output*
-	      "Processes a source-control managed directory tree~%"))
+              "Processes a source-control managed directory tree~%"))
   (format *error-output* "Action: update, commit, or status~%")
   (format *error-output* "OPTIONS~%")
   (format *error-output* "   -m <str>    Set commit string~%"))
@@ -149,27 +149,27 @@ Returns a list of directories managed by CVS or SVN."
     (t
      (let ((pos (match-unique-abbreviation arg '("update" "commit" "status"))))
        (cond
-	 ((eql pos 0) :update)
-	 ((eql pos 1) :commit)
-	 ((eql pos 2) :status)
-	 (t
-	  (usage "Unknown action: ~A" arg)
-	  (quit 1)))))))
+         ((eql pos 0) :update)
+         ((eql pos 1) :commit)
+         ((eql pos 2) :status)
+         (t
+          (usage "Unknown action: ~A" arg)
+          (quit 1)))))))
 
 
 (defun main (&optional (argv (command-line-arguments)))
   (let ((*progname* (car argv)))
     (multiple-value-bind (args options errors)
-	(getopt (cdr argv) '(("m" :required)))
+        (getopt (cdr argv) '(("m" :required)))
       (when (or errors (/= 1 (length args)))
-	(usage)
-	(quit 1))
+        (usage)
+        (quit 1))
       (let ((action (parse-action-arg (first args))))
-	(unless action
-	  (usage "Invalid action ~A" (first args))
-	  (quit 1))
-	(dolist (dir (mklist (filter-tree (directory-tree (cwd)))))
-	  (process-vcs-directory dir action options))))
+        (unless action
+          (usage "Invalid action ~A" (first args))
+          (quit 1))
+        (dolist (dir (mklist (filter-tree (directory-tree (cwd)))))
+          (process-vcs-directory dir action options))))
     (quit 0)))
 
 ;;(main)