[Cl-darcs-cvs] r14 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Sat Jun 24 14:47:24 2006
New Revision: 14

Modified:
   cl-darcs/trunk/prefs.lisp
Log:
Add {get,set}-preflist, write-default-prefs.


Modified: cl-darcs/trunk/prefs.lisp
==============================================================================
--- cl-darcs/trunk/prefs.lisp	(original)
+++ cl-darcs/trunk/prefs.lisp	Sat Jun 24 14:47:24 2006
@@ -19,19 +19,13 @@
 (defun read-prefs (upath)
   "Read all preferences from repository at UPATH.
 Return an alist with strings."
-  (let ((stream (ignore-errors
-		  (open-upath 
-			 (upath-subdir upath '("_darcs" "prefs") "prefs"))))
-	alist)
-    (when stream
-      (with-open-stream (in stream)
-	(loop for line = (read-line in nil)
-	      while line
-	      do (let ((pos (position #\Space line)))
-		   (when pos
-		     (let ((name (subseq line 0 pos))
-			   (value (subseq line (1+ pos))))
-		       (push (cons name value) alist)))))))
+  (let (alist)
+    (loop for line in (get-preflist upath "prefs")
+       do (let ((pos (position #\Space line)))
+	    (when pos
+	      (let ((name (subseq line 0 pos))
+		    (value (subseq line (1+ pos))))
+		(push (cons name value) alist)))))
     alist))
 
 (defun get-pref (upath prefname)
@@ -46,9 +40,68 @@
     (if entry
 	(setf (cdr entry) value)
 	(push (cons prefname value) prefs))
-    (with-open-file (out (upath-subdir repopath '("_darcs" "prefs") "prefs")
-			 :direction :output
-			 :if-exists :supersede
-			 :if-does-not-exist :create)
-      (dolist (pref prefs)
-	(format out "~A ~A~%" (car pref) (cdr pref))))))
+    (set-preflist repopath "prefs"
+		  (mapcar (lambda (p) (format nil "~A ~A" (car p) (cdr p))) prefs))))
+
+(defun get-preflist (upath filename)
+  "Get list of lines in preference file named by FILENAME in repository UPATH."
+  (let ((stream (ignore-errors
+		  (open-upath 
+		   (upath-subdir upath '("_darcs" "prefs") filename)))))
+    (when stream
+      (with-open-stream (in stream)
+	(flet ((unimportantp (line)
+		 (or (zerop (length line))
+		     (char= (elt line 0) #\#)
+		     (eql (search "v v v v v v v" line) 0)
+		     (eql (search "*************" line) 0)
+		     (eql (search "^ ^ ^ ^ ^ ^ ^" line) 0))))
+	  (loop for line = (read-line in nil)
+	     while line 
+	     unless (unimportantp line) collect line))))))
+
+(defun set-preflist (upath filename preflist)
+  "Set preferences in FILENAME in repo UPATH to PREFLIST."
+  (with-open-file (out (upath-subdir upath '("_darcs" "prefs") filename)
+		       :direction :output
+		       :if-exists :supersede
+		       :if-does-not-exist :create)
+    (dolist (pref preflist)
+      (format out "~A~%" pref))))
+
+(defun write-default-prefs (repopath)
+  (default-boring repopath)
+  (default-binaries repopath)
+  (set-preflist repopath "motd" ()))
+
+(defun default-boring (repopath)
+  (set-preflist repopath "boring"
+		'("# Boring file regexps:"
+		  "\\.hi$" 
+                  "\\.o$" "\\.o\\.cmd$" 
+                  "# *.ko files aren't boring by default because they might" 
+                  "# be Korean translations rather than kernel modules." 
+                  "# \\.ko$" 
+                  "\\.ko\\.cmd$" "\\.mod\\.c$" 
+                  "(^|/)\\.tmp_versions($|/)" "(^|/)CVS($|/)" "(^|/)RCS($|/)" "~$" 
+                  "#(^|/)\\.[^/]" "(^|/)_darcs($|/)" 
+                  "\\.bak$" "\\.BAK$" "\\.orig$" "(^|/)vssver\\.scc$" 
+                  "\\.swp$" "(^|/)MT($|/)" 
+                  "(^|/)\\{arch\\}($|/)" "(^|/).arch-ids($|/)" 
+                  "(^|/)," "\\.class$" "\\.prof$" "(^|/)\\.DS_Store$" 
+                  "(^|/)BitKeeper($|/)" "(^|/)ChangeSet($|/)" 
+                  "(^|/)\\.svn($|/)" "\\.py[co]$" "\\#" "\\.cvsignore$" 
+                  "(^|/)Thumbs\\.db$" 
+                  "(^|/)autom4te\\.cache($|/)")))
+
+(defun default-binaries (repopath)
+  (set-preflist
+   repopath "binaries"
+   (cons "# Binary file regexps:" 
+	 (mapcan (lambda (ext)
+		   (list (format nil "\\.~A$" ext)
+			 (format nil "\\.~A$" (string-upcase ext))))
+		 '("png" "gz" "pdf" "jpg" "jpeg" "gif" "tif" 
+		   "tiff" "pnm" "pbm" "pgm" "ppm" "bmp" "mng" 
+		   "tar" "bz2" "z" "zip" "jar" "so" "a" 
+		   "tgz" "mpg" "mpeg" "iso" "exe" "doc")))))