source: cl-darcs/tags/0.1.0/prefs.lisp

Last change on this file was 15, checked in by Magnus Henoch, 16 years ago

Add add-to-preflist and set-default-repo.

File size: 4.6 KB
Line 
1;;; Copyright (C) 2006 Magnus Henoch
2;;;
3;;; This program is free software; you can redistribute it and/or
4;;; modify it under the terms of the GNU General Public License as
5;;; published by the Free Software Foundation; either version 2 of the
6;;; License, or (at your option) any later version.
7;;;
8;;; This program is distributed in the hope that it will be useful,
9;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11;;; General Public License for more details.
12;;;
13;;; You should have received a copy of the GNU General Public License
14;;; along with this program; if not, write to the Free Software
15;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
16
17(in-package :darcs)
18
19(defun read-prefs (upath)
20  "Read all preferences from repository at UPATH.
21Return an alist with strings."
22  (let (alist)
23    (loop for line in (get-preflist upath "prefs")
24       do (let ((pos (position #\Space line)))
25            (when pos
26              (let ((name (subseq line 0 pos))
27                    (value (subseq line (1+ pos))))
28                (push (cons name value) alist)))))
29    alist))
30
31(defun get-pref (upath prefname)
32  "Get value of PREFNAME from repository at UPATH.
33Return nil if no value was found."
34  (cdr (assoc prefname (read-prefs upath) :test #'string=)))
35
36(defun set-pref (repopath prefname value)
37  "Set value of PREFNAME to VALUE in REPOPATH."
38  (let* ((prefs (read-prefs repopath))
39         (entry (assoc prefname prefs :test #'string=)))
40    (if entry
41        (setf (cdr entry) value)
42        (push (cons prefname value) prefs))
43    (set-preflist repopath "prefs"
44                  (mapcar (lambda (p) (format nil "~A ~A" (car p) (cdr p))) prefs))))
45
46(defun get-preflist (upath filename)
47  "Get list of lines in preference file named by FILENAME in repository UPATH."
48  (let ((stream (ignore-errors
49                  (open-upath 
50                   (upath-subdir upath '("_darcs" "prefs") filename)))))
51    (when stream
52      (with-open-stream (in stream)
53        (flet ((unimportantp (line)
54                 (or (zerop (length line))
55                     (char= (elt line 0) #\#)
56                     (eql (search "v v v v v v v" line) 0)
57                     (eql (search "*************" line) 0)
58                     (eql (search "^ ^ ^ ^ ^ ^ ^" line) 0))))
59          (loop for line = (read-line in nil)
60             while line 
61             unless (unimportantp line) collect line))))))
62
63(defun set-preflist (upath filename preflist)
64  "Set preferences in FILENAME in repo UPATH to PREFLIST."
65  (with-open-file (out (upath-subdir upath '("_darcs" "prefs") filename)
66                       :direction :output
67                       :if-exists :supersede
68                       :if-does-not-exist :create)
69    (dolist (pref preflist)
70      (write-line pref out))))
71
72(defun add-to-preflist (upath filename pref)
73  "Add PREF to preferences in FILENAME in repo UPATH.
74Do nothing if it's already there."
75  (let ((prefs (get-preflist upath filename)))
76    (unless (member pref prefs :test #'string=)
77      (with-open-file (out (upath-subdir upath '("_darcs" "prefs") filename)
78                           :direction :output
79                           :if-exists :append
80                           :if-does-not-exist :create)
81        (write-line pref out)))))
82
83(defun write-default-prefs (repopath)
84  (default-boring repopath)
85  (default-binaries repopath)
86  (set-preflist repopath "motd" ()))
87
88(defun default-boring (repopath)
89  (set-preflist repopath "boring"
90                '("# Boring file regexps:"
91                  "\\.hi$" 
92                  "\\.o$" "\\.o\\.cmd$" 
93                  "# *.ko files aren't boring by default because they might" 
94                  "# be Korean translations rather than kernel modules." 
95                  "# \\.ko$" 
96                  "\\.ko\\.cmd$" "\\.mod\\.c$" 
97                  "(^|/)\\.tmp_versions($|/)" "(^|/)CVS($|/)" "(^|/)RCS($|/)" "~$" 
98                  "#(^|/)\\.[^/]" "(^|/)_darcs($|/)" 
99                  "\\.bak$" "\\.BAK$" "\\.orig$" "(^|/)vssver\\.scc$" 
100                  "\\.swp$" "(^|/)MT($|/)" 
101                  "(^|/)\\{arch\\}($|/)" "(^|/).arch-ids($|/)" 
102                  "(^|/)," "\\.class$" "\\.prof$" "(^|/)\\.DS_Store$" 
103                  "(^|/)BitKeeper($|/)" "(^|/)ChangeSet($|/)" 
104                  "(^|/)\\.svn($|/)" "\\.py[co]$" "\\#" "\\.cvsignore$" 
105                  "(^|/)Thumbs\\.db$" 
106                  "(^|/)autom4te\\.cache($|/)")))
107
108(defun default-binaries (repopath)
109  (set-preflist
110   repopath "binaries"
111   (cons "# Binary file regexps:" 
112         (mapcan (lambda (ext)
113                   (list (format nil "\\.~A$" ext)
114                         (format nil "\\.~A$" (string-upcase ext))))
115                 '("png" "gz" "pdf" "jpg" "jpeg" "gif" "tif" 
116                   "tiff" "pnm" "pbm" "pgm" "ppm" "bmp" "mng" 
117                   "tar" "bz2" "z" "zip" "jar" "so" "a" 
118                   "tgz" "mpg" "mpeg" "iso" "exe" "doc")))))
119
120(defun set-default-repo (repopath repostring)
121  (set-preflist repopath "defaultrepo" (list repostring))
122  (add-to-preflist repopath "repos" repostring))
Note: See TracBrowser for help on using the repository browser.