[Summary view] [Print] [Text view]

   1  #!/usr/local/bin/clisp 
   2  ;(setq *args* '("(5 24 5759)"))
   3  
   4  
   5  ;;;  calculate yahrzeit.
   6  ;;;  usage:  test.cl "( mo day year )"
   7  ;;;     Returns the Gregorian date and Parshah
   8  ;;;
   9  
  10  (setq dbg nil)
  11  (load 'yc.cl)
  12   
  13  ;(format t "~%") 
  14  
  15  
  16  (defun yahr-dates (y-date h-year)
  17    (let* ( (yahr-abs (hebrew-calendar-yahrzeit y-date h-year))
  18        (yahr-greg (calendar-gregorian-from-absolute yahr-abs))
  19        (my-dow  (calendar-day-of-week yahr-greg))
  20        (date (calendar-gregorian-from-absolute 
  21           (- yahr-abs (if (=  my-dow 6) 0 (1+ my-dow))) ))  ); adjust to previous shb.
  22      (declare (special date ))
  23      
  24      (format t "~A, ~A~%~A~%" (aref calendar-day-name-array my-dow) (calendar-date-string yahr-greg) 
  25          (diary-parasha))))
  26  ;(trace (yahr-dates :step-if t))
  27  (with-open-file (myargs "/var/tmp/yzargs")
  28    (let* ((h-today (calendar-hebrew-from-absolute
  29                     (calendar-absolute-from-gregorian date)))
  30           (h-year (third h-today))
  31           (my-date (read-from-string (read-line myargs)))
  32           (yymm00 (list (car my-date) (car (cdr my-date)) 5760))
  33           (today0 (list (car h-today) (car (cdr h-today)) 5760)))
  34      
  35      (if (and
  36           (equal (car my-date) 7)
  37           (> (calendar-absolute-from-hebrew today0) 
  38              (calendar-absolute-from-hebrew yymm00)))
  39          (setq h-year (1+ h-year)))
  40      (yahr-dates my-date h-year)
  41      (if (and (hebrew-calendar-leap-year-p h-year)
  42               (equal  (car my-date) 12))
  43          (progn
  44            (setf (car my-date) (1+ (car my-date)))
  45            (yahr-dates my-date h-year))))    
  46  
  47  
  48  (if dbg
  49      (progn
  50      (print date) 
  51      (print today0)
  52      (print yymm00)
  53      (print my-date)
  54      (print h-year)))
  55  )
  56  ;(list-yahrzeit-dates (list 10 17 1974) 2000) (5 24 5759)