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")))))