[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  (if (equal (machine-instance) "bsd3 [192.168.64.3]")
  12      (progn
  13        (load 'yc.cl))
  14      (progn
  15        (load '/usr/home/yi/lisp/yahrweb.cl)))
  16  
  17  ;(format t "~%") 
  18  
  19  
  20  (defun yahr-dates (y-date h-year)
  21    (let* ( (yahr-abs (hebrew-calendar-yahrzeit y-date h-year))
  22        (yahr-greg (calendar-gregorian-from-absolute yahr-abs))
  23        (my-dow  (calendar-day-of-week yahr-greg))
  24        (date (calendar-gregorian-from-absolute 
  25           (- yahr-abs (if (=  my-dow 6) 0 (1+ my-dow))) ))  ); adjust to previous shb.
  26      (declare (special date ))
  27      
  28      (format t "~A~%~A~%" (calendar-date-string yahr-greg) 
  29          (diary-parasha))))
  30  ;(trace (yahr-dates :step-if t))
  31  
  32  
  33  (let* ((h-today (calendar-hebrew-from-absolute
  34          (calendar-absolute-from-gregorian date)))
  35        (h-year (third h-today))
  36              (my-date (read-from-string (car *args*)))
  37        (yymm00 (list (car my-date) (car (cdr my-date)) 5760))
  38        (today0 (list (car h-today) (car (cdr h-today)) 5760)))
  39  
  40          (if (and
  41               (equal (car my-date) 7)
  42               (> (calendar-absolute-from-hebrew today0) 
  43                  (calendar-absolute-from-hebrew yymm00)))
  44              (setq h-year (1+ h-year)))
  45          (yahr-dates my-date h-year)
  46          (if (and (hebrew-calendar-leap-year-p h-year)
  47                   (equal  (car my-date) 12))
  48              (progn
  49                (setf (car my-date) (1+ (car my-date)))
  50                (yahr-dates my-date h-year)))    
  51  
  52  
  53  (if dbg
  54      (progn
  55      (print date) 
  56      (print today0)
  57      (print yymm00)
  58      (print my-date)
  59      (print h-year)))
  60  )
  61  ;(list-yahrzeit-dates (list 10 17 1974) 2000) (5 24 5759)