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,32 +29,43 @@
 ;; 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))
-      (cond
-       ((maybe-obtain-dot-lock file-name)
-	#t)
-       ((and stale-time
-	     (with-errno-handler
-	      ((errno packet)
-	       (else #f))
-	      (> (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))
-       (else
-	(sleep (+ (quotient (* retry-interval 3) 4)
-		  (random (quotient retry-interval 2))))
-	(cond ((not retry-number)
-	       (loop retry-number))
-	      ((> retry-number 0)
-	       (loop (- retry-number 1)))
-	      (else #f)))))))
+(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)
+	  (if broken?
+	      'broken
+	      #t))
+	 ((and stale-time
+	       (with-errno-handler
+		((errno packet)
+		 (else #f))
+		(> (time)
+		   (+ (file-last-status-change (make-lock-file-name file-name))
+		      stale-time))))
+	  (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 broken?))
+		((> retry-number 0)
+		 (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