Made arguments to OBTAIN-DOT-LOCK optional and supply sensible

defaults.
All timings are now in seconds.
Add interface procedure BREAK-DOT-LOCK.
Indicate broken lock by BROKEN return value from OBTAIN-DOT-LOCK.

scsh/dot-locking.scm

@@ -29,12 +29,19 @@
 ;; STALE-TIME is the minimum age of a lock to be broken
 ;; if #f, don't break the lock
 
-(define (obtain-dot-lock file-name retry-interval retry-number stale-time)
-  (let ((lock-file-name (make-lock-file-name file-name)))
-    (let loop ((retry-number retry-number))
+(define (obtain-dot-lock file-name . args)
+  (let-optionals args ((retry-seconds 1)
+		       (retry-number #f)
+		       (stale-time 300))
+    (let ((lock-file-name (make-lock-file-name file-name))
+	  (retry-interval (* retry-seconds 1000)))
+      (let loop ((retry-number retry-number)
+		 (broken? #f))
 	(cond
 	 ((maybe-obtain-dot-lock file-name)
-	#t)
+	  (if broken?
+	      'broken
+	      #t))
 	 ((and stale-time
 	       (with-errno-handler
 		((errno packet)
@@ -42,19 +49,23 @@
 		(> (time)
 		   (+ (file-last-status-change (make-lock-file-name file-name))
 		      stale-time))))
-	(with-errno-handler
-	 ((errno packet)
-	  ((errno/noent) 'dont-care))
-	 (delete-file lock-file-name))
-	(loop retry-number))
+	  (break-dot-lock file-name)
+	  (loop retry-number #t))
 	 (else
 	  (sleep (+ (quotient (* retry-interval 3) 4)
 		    (random (quotient retry-interval 2))))
 	  (cond ((not retry-number)
-	       (loop retry-number))
+		 (loop retry-number broken?))
 		((> retry-number 0)
-	       (loop (- retry-number 1)))
-	      (else #f)))))))
+		 (loop (- retry-number 1) broken?))
+		(else
+		 #f))))))))
+
+(define (break-dot-lock file-name)
+  (with-errno-handler
+   ((errno packet)
+    ((errno/noent) 'dont-care))
+   (delete-file (make-lock-file-name file-name))))
 
 (define (with-dot-lock* file-name thunk)
   (dynamic-wind