base: Add 'display-schedule' procedure

This procedure is a more generic and less coupled version of
'get-schedule' which has been kept for backward compatibility and
deprecated.

* src/mcron/base.scm (display-schedule): New procedure.
(get-schedule): Move to ...
* src/mcron/core.scm: ... here.
* src/mcron/scripts/cron.scm (main): Use 'display-schedule'.
* src/mcron/scripts/mcron.scm (main): Likewise.
* doc/mcron.texi (The base module): Document it.

doc/mcron.texi

@@ -1233,9 +1233,12 @@ entry.  All jobs on the current job list that are scheduled to be run
 under this personality are removed from the job list.
 @end deffn
 
-@deffn{Scheme procedure} get-schedule count
+@deffn{Scheme procedure} display-schedule @var{count} [@var{port}]
 @cindex schedule of jobs
-The argument @var{count} should be an integer value giving the number
+This procedure is used to display a textual list of the next COUNT jobs
+to run.
+
+The argument @var{count} must be an integer value giving the number
 of time-points in the future to report that jobs will run as.  Note
 that this procedure is disruptive; if @code{run-job-loop} is called
 after this procedure, the first job to run will be the one after the

src/mcron/base.scm

@@ -26,7 +26,7 @@
   #:use-module (srfi srfi-9)
   #:export (add-job
             remove-user-jobs
-            get-schedule
+            display-schedule
             run-job-loop
             ;; Deprecated and undocumented procedures.
             use-system-job-list
@@ -136,35 +136,27 @@ recurse the list."
                (else
                 (loop rest next-time next-jobs))))))))
 
-;; Create a string containing a textual list of the next count jobs to run.
+(define* (display-schedule count #:optional (port (current-output-port)))
-;;
+  "Display on PORT a textual list of the next COUNT jobs to run.  This
-;; Enter a loop of displaying the next set of jobs to run, artificially
+simulates the run of the job loop to display the resquested information.
-;; forwarding the time to the next time point (instead of waiting for it to
+Since calling this procedure has the effect of mutating the job timings, the
-;; occur as we would do in a normal run of mcron), and recurse around the loop
+program must exit after.  Otherwise the internal data state will be left
-;; count times.
+unusable."
-;;
+  (unless (<= count 0)
-;; Note that this has the effect of mutating the job timings. Thus the program
+    (match (find-next-jobs)
-;; must exit after calling this function; the internal data state will be left
+      ((#f . jobs)
-;; unusable.
+       #f)
-
+      ((time . jobs)
-(define (get-schedule count)
+       (let ((date-string (strftime "%c %z\n" (localtime time))))
-  (with-output-to-string
-    (lambda ()
-      (do ((count count (- count 1)))
-          ((eqv? count 0))
-        (and-let*
-         ((next-jobs (find-next-jobs))
-          (time (car next-jobs))
-          (date-string (strftime "%c %z\n" (localtime time))))
          (for-each (lambda (job)
-                     (display date-string)
+                     (display date-string port)
-                     (display (job:displayable job))
+                     (display (job:displayable job) port)
-                     (newline)(newline)
+                     (newline port)
+                     (newline port)
                      (job:next-time-set! job ((job:next-time-function job)
                                               (job:next-time job))))
-                   (cdr next-jobs)))))))
+                   jobs))))
-
+    (display-schedule (- count 1) port)))
-
 
 ;; For proper housekeeping, it is necessary to keep a record of the number of
 ;; child processes we fork off to run the jobs.

src/mcron/core.scm

@@ -20,9 +20,10 @@
 
 (define-module (mcron core)
   #:use-module (mcron base)
+  #:export (;; Deprecated
+            get-schedule)
   #:re-export (add-job
                remove-user-jobs
-               get-schedule
                run-job-loop
                clear-environment-mods
                append-environment-mods
@@ -30,3 +31,7 @@
                use-system-job-list
                use-user-job-list
                clear-system-jobs))
+
+(define (get-schedule count)
+  (with-output-to-string
+    (lambda () (display-schedule count))))

src/mcron/scripts/cron.scm

@@ -157,7 +157,7 @@ option.\n")
                       (option-ref opts 'noetc #f))
       (cond ((option-ref opts 'schedule #f) ;display jobs schedule
              => (λ (count)
-                  (display (get-schedule (max 1 (string->number count))))
+                  (display-schedule (max 1 (string->number count)))
                   (exit 0)))
             (else (case (primitive-fork) ;run the daemon
                     ((0)

src/mcron/scripts/mcron.scm

@@ -83,7 +83,7 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
 
   (cond ((assq-ref opts 'schedule) ;display jobs schedule
          => (λ (count)
-              (display (get-schedule (max 1 count)))
+              (display-schedule (max 1 count))
               (exit 0)))
         ((assq-ref opts 'daemon) ;run mcron as a daemon
          (case (primitive-fork)