Start rewrite code for right deadline integration
This commit is contained in:
parent
dd816982e7
commit
be26b63924
@ -103,7 +103,7 @@
|
|||||||
(if (not path-end) #f
|
(if (not path-end) #f
|
||||||
(path-split str 0 path-end))))
|
(path-split str 0 path-end))))
|
||||||
(dates (substring/find str #\[ #\])))
|
(dates (substring/find str #\[ #\])))
|
||||||
(if (or (not path) (not dates))
|
(if (or (not path) (not dates) (null? dates))
|
||||||
#f
|
#f
|
||||||
(let ((date-start (string->date (car dates) date-time-format)))
|
(let ((date-start (string->date (car dates) date-time-format)))
|
||||||
(let-values (((date-end duration)
|
(let-values (((date-end duration)
|
||||||
@ -134,6 +134,63 @@
|
|||||||
(define (read-timesheet filename)
|
(define (read-timesheet filename)
|
||||||
(read-and-parse-file filename parse-task-string))
|
(read-and-parse-file filename parse-task-string))
|
||||||
|
|
||||||
|
;;; Compare paths
|
||||||
|
(define (path<? a b)
|
||||||
|
(let loop ((a a) (b b))
|
||||||
|
(if (and (null? a) (null? b)) #f
|
||||||
|
(if (null? a) #t
|
||||||
|
(if (null? b) #f
|
||||||
|
(if (string=? (car a) (car b))
|
||||||
|
(loop (cdr a) (cdr b))
|
||||||
|
(string< (car a) (car b))))))))
|
||||||
|
|
||||||
|
;;; Compare deadlines by path
|
||||||
|
(define (deadline<? a b)
|
||||||
|
(path<? (car a) (car b)))
|
||||||
|
|
||||||
|
;;; Read timesheet and deadlines
|
||||||
|
(define (read-timesheet1 filename)
|
||||||
|
(if (file-exists? filename)
|
||||||
|
(call-with-input-file filename
|
||||||
|
(lambda (port)
|
||||||
|
(let loop ((record-type 'unknown)
|
||||||
|
(timerecords '())
|
||||||
|
(deadlines '()))
|
||||||
|
(let ((line (get-line port)))
|
||||||
|
(if (eof-object? line)
|
||||||
|
(values (reverse timerecords)
|
||||||
|
(sort deadlines deadline<?))
|
||||||
|
(let ((line (string-trim-both line)))
|
||||||
|
(cond
|
||||||
|
((or (string-null? line)
|
||||||
|
(eq? (string-ref line 0) #\#))
|
||||||
|
(loop record-type timerecords deadlines))
|
||||||
|
((string-ci=? line "--- DEADLINES")
|
||||||
|
(loop 'deadline timerecords deadlines))
|
||||||
|
((string-ci=? line "--- TIMESHEET")
|
||||||
|
(loop 'timerecord timerecords deadlines))
|
||||||
|
(else
|
||||||
|
(cond
|
||||||
|
((eq? record-type 'timerecord)
|
||||||
|
(loop record-type
|
||||||
|
(let ((item (parse-task-string line)))
|
||||||
|
(if item
|
||||||
|
(cons item timerecords)
|
||||||
|
(begin
|
||||||
|
(format #t "Warning: Line '~a' is not a timerecord. Skip.\n" line)
|
||||||
|
timerecords)))
|
||||||
|
deadlines))
|
||||||
|
((eq? record-type 'deadline)
|
||||||
|
(loop record-type
|
||||||
|
timerecords
|
||||||
|
(let ((item (parse-deadline-string line)))
|
||||||
|
(if item
|
||||||
|
(cons item deadlines)
|
||||||
|
(begin
|
||||||
|
(format #t "Warning: Line '~a' is not a deadline. Skip.\n" line)
|
||||||
|
deadlines))))))))))))))
|
||||||
|
'()))
|
||||||
|
|
||||||
;;; Return difference of two dates
|
;;; Return difference of two dates
|
||||||
(define (date-difference d1 d2)
|
(define (date-difference d1 d2)
|
||||||
(time-difference
|
(time-difference
|
||||||
@ -578,8 +635,8 @@
|
|||||||
|
|
||||||
;;; ================================ MAIN FUNCTION ==================================
|
;;; ================================ MAIN FUNCTION ==================================
|
||||||
(define (main cmdl)
|
(define (main cmdl)
|
||||||
(let ((command (cdr cmdl))
|
(let ((command (cdr cmdl)))
|
||||||
(sheet (read-timesheet ts-file)))
|
(let-values (((sheet deadlines) (read-timesheet1 ts-file)))
|
||||||
(if (null? command)
|
(if (null? command)
|
||||||
|
|
||||||
;; Show running task
|
;; Show running task
|
||||||
@ -634,7 +691,8 @@
|
|||||||
(not (null? new-sheet)))
|
(not (null? new-sheet)))
|
||||||
(with-output-to-file ts-file
|
(with-output-to-file ts-file
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(print-timesheet new-sheet)))))))))
|
(print-timesheet new-sheet))))))))))
|
||||||
|
|
||||||
;;; JUST DO IT!
|
;;; JUST DO IT!
|
||||||
(main (command-line))
|
;(main (command-line))
|
||||||
|
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user