source: cl-darcs/trunk/prefs.lisp

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

Add has-prefs-dir. Don't apply CHANGE-PREF-PATCHes unless there is a prefs directory.

File size: 5.0 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 has-prefs-dir (repo)
20  "Return true if REPO has a _darcs/prefs subdirectory."
21  ;; This is currently only used for checking whether we should write
22  ;; preferences, so it doesn't matter that this implementation
23  ;; doesn't work for HTTP.
24  (fad:directory-exists-p (upath-subdir repo '("_darcs" "prefs"))))
25
26(defun read-prefs (upath)
27  "Read all preferences from repository at UPATH.
28Return an alist with strings."
29  (let (alist)
30    (loop for line in (get-preflist upath "prefs")
31       do (let ((pos (position #\Space line)))
32            (when pos
33              (let ((name (subseq line 0 pos))
34                    (value (subseq line (1+ pos))))
35                (push (cons name value) alist)))))
36    alist))
37
38(defun get-pref (upath prefname)
39  "Get value of PREFNAME from repository at UPATH.
40Return nil if no value was found."
41  (cdr (assoc prefname (read-prefs upath) :test #'string=)))
42
43(defun set-pref (repopath prefname value)
44  "Set value of PREFNAME to VALUE in REPOPATH."
45  (let* ((prefs (read-prefs repopath))
46         (entry (assoc prefname prefs :test #'string=)))
47    (if entry
48        (setf (cdr entry) value)
49        (push (cons prefname value) prefs))
50    (set-preflist repopath "prefs"
51                  (mapcar (lambda (p) (format nil "~A ~A" (car p) (cdr p))) prefs))))
52
53(defun get-preflist (upath filename)
54  "Get list of lines in preference file named by FILENAME in repository UPATH."
55  (let ((stream (ignore-errors
56                  (open-upath 
57                   (upath-subdir upath '("_darcs" "prefs") filename)))))
58    (when stream
59      (with-open-stream (in stream)
60        (flet ((unimportantp (line)
61                 (or (zerop (length line))
62                     (char= (elt line 0) #\#)
63                     (eql (search "v v v v v v v" line) 0)
64                     (eql (search "*************" line) 0)
65                     (eql (search "^ ^ ^ ^ ^ ^ ^" line) 0))))
66          (loop for line = (read-line in nil)
67             while line 
68             unless (unimportantp line) collect line))))))
69
70(defun set-preflist (upath filename preflist)
71  "Set preferences in FILENAME in repo UPATH to PREFLIST."
72  (with-open-file (out (upath-subdir upath '("_darcs" "prefs") filename)
73                       :direction :output
74                       :if-exists :supersede
75                       :if-does-not-exist :create)
76    (dolist (pref preflist)
77      (write-line pref out))))
78
79(defun add-to-preflist (upath filename pref)
80  "Add PREF to preferences in FILENAME in repo UPATH.
81Do nothing if it's already there."
82  (let ((prefs (get-preflist upath filename)))
83    (unless (member pref prefs :test #'string=)
84      (with-open-file (out (upath-subdir upath '("_darcs" "prefs") filename)
85                           :direction :output
86                           :if-exists :append
87                           :if-does-not-exist :create)
88        (write-line pref out)))))
89
90(defun write-default-prefs (repopath)
91  (default-boring repopath)
92  (default-binaries repopath)
93  (set-preflist repopath "motd" ()))
94
95(defun default-boring (repopath)
96  (set-preflist repopath "boring"
97                '("# Boring file regexps:"
98                  "\\.hi$" 
99                  "\\.o$" "\\.o\\.cmd$" 
100                  "# *.ko files aren't boring by default because they might" 
101                  "# be Korean translations rather than kernel modules." 
102                  "# \\.ko$" 
103                  "\\.ko\\.cmd$" "\\.mod\\.c$" 
104                  "(^|/)\\.tmp_versions($|/)" "(^|/)CVS($|/)" "(^|/)RCS($|/)" "~$" 
105                  "#(^|/)\\.[^/]" "(^|/)_darcs($|/)" 
106                  "\\.bak$" "\\.BAK$" "\\.orig$" "(^|/)vssver\\.scc$" 
107                  "\\.swp$" "(^|/)MT($|/)" 
108                  "(^|/)\\{arch\\}($|/)" "(^|/).arch-ids($|/)" 
109                  "(^|/)," "\\.class$" "\\.prof$" "(^|/)\\.DS_Store$" 
110                  "(^|/)BitKeeper($|/)" "(^|/)ChangeSet($|/)" 
111                  "(^|/)\\.svn($|/)" "\\.py[co]$" "\\#" "\\.cvsignore$" 
112                  "(^|/)Thumbs\\.db$" 
113                  "(^|/)autom4te\\.cache($|/)")))
114
115(defun default-binaries (repopath)
116  (set-preflist
117   repopath "binaries"
118   (cons "# Binary file regexps:" 
119         (mapcan (lambda (ext)
120                   (list (format nil "\\.~A$" ext)
121                         (format nil "\\.~A$" (string-upcase ext))))
122                 '("png" "gz" "pdf" "jpg" "jpeg" "gif" "tif" 
123                   "tiff" "pnm" "pbm" "pgm" "ppm" "bmp" "mng" 
124                   "tar" "bz2" "z" "zip" "jar" "so" "a" 
125                   "tgz" "mpg" "mpeg" "iso" "exe" "doc")))))
126
127(defun set-default-repo (repopath repostring)
128  (set-preflist repopath "defaultrepo" (list repostring))
129  (add-to-preflist repopath "repos" repostring))
Note: See TracBrowser for help on using the repository browser.