diary-float による org-mode の日付作成

(y-or-n-p (message "date=%s" date))

(defun diary-lecture(stt ival recc &optional exs &rest sbs)
  (let* (
         (sttd  (calendar-absolute-from-gregorian stt ))  ;; stt の日付を 6 桁数値で
         (today (calendar-absolute-from-gregorian date))  ;; 今日の日付
         (diffd (- today sttd)) ;; stt の日付と今日の差分. stt より今日の方が後であれば >0
         (nths   nil)  ;; 今日は何周目かを得る
         (jst    nil)  ;; 戻り値 t or nil
         )
    ;; diary-limited-cyclic を参照
    (if (and (not (minusp diffd))
             (zerop (% diffd ival))
             (< (floor diffd ival) recc))
        (setq nths (+ (/ diffd ival) 1)))

    ;; 上の条件を満たしていれば nths に何か値が入ってる
    (if nths
        (setq jst (diary-lecture-exception nths exs))
      (setq jst (diary-lecture-substitution today sbs))
      )
    jst))

;; 今日が例外週(exs) であれば nil を返す
(defun diary-lecture-exception(nths exs)
  (let ((jst t)
        (ex  nil))
    (while exs
      (setq ex (car exs))
      (if (= nths ex) (setq jst nil))
      (setq exs (cdr exs)))
    jst))

;; 今日が代わりの日付であれば t を返す
(defun diary-lecture-substitution(today sbs)
  (let ((jst nil)
        (sb  nil)
        (sbg nil))
    (while sbs
      (setq sb (car sbs))
      (setq sbg (calendar-absolute-from-gregorian sb))
      (if (= today sbg) (setq jst t))
      (setq sbs (cdr sbs)))
    jst))

;; 繰り返し回数は使いにくいので日付で指定する
;; stt:    始まりの日 '(4 11 2018)
;; ival:   何日おき   7
;; end:    終了日     '(8 10 2018)
;; exdays: 除外日     '((5 11 2018) (3 11 2018))
;; sbdays: 代わり日   '((5 12 2018) (3 12 2018))
(defun diary-lecture2(stt ival end &optional exdays sbdays)
  (let* (
         (sttd  (calendar-absolute-from-gregorian stt ))  ;; stt の日付を 6 桁数値で
         (today (calendar-absolute-from-gregorian date))  ;; 今日の日付
         (endd  (calendar-absolute-from-gregorian end))   ;; end の日付を 6 桁数値で
         (diffd (- today sttd))
         (diffe (- endd  today))
         (nths   nil)  ;; 今日は何周目かを得る
         (jst    nil)  ;; 戻り値 t or nil
         )
    (if (and (not (minusp diffd))
             (not (minusp diffe))
             (zerop (% diffd ival)))
        (setq nths (+ (/ diffd ival) 1)))

    ;; 上の条件を満たしていれば
    (if nths
        (setq jst (not (diary-lecture-substitution today exdays)))
      (setq jst (diary-lecture-substitution today sbdays)))
    jst))

(defun diary-habit-last-day-of-month(stt)
  (let* ((jst0 nil)
         (jst  nil)
         (sttd  (calendar-absolute-from-gregorian stt ))
         (today (calendar-absolute-from-gregorian date))
         (diffd (- today sttd))
         ;; (calendar-last-day-of-month 3月 2017年) ;=> 31 日
         (lday (calendar-last-day-of-month (nth 0 date) (nth 2 date)))
         )
    (if (not (minusp diffd)) (setq jst0 t))
    (if (and jst0 (= (nth 1 date) lday)) (setq jst t))
    jst
    ))

(defun diary-habit-weekday(stt &rest wds)
  (let* ((jst0 nil)
         (jst  nil)
         (sttd  (calendar-absolute-from-gregorian stt ))
         (today (calendar-absolute-from-gregorian date))
         (diffd (- today sttd)))
    ;(y-or-n-p (message "date=%s" date))
    (if (not (minusp diffd)) (setq jst0 t))
    (if (and jst0 (not wds)) (setq jst  t)) ;; 毎日
    (if (and jst0 wds)       (setq jst (diary-habit-weekday-week date wds)))
    jst
    ))

(defun diary-habit-weekday-week(date wds)
  (let ((wd nil)
        (jst nil))
    (while wds
      (setq wd (car wds))
      (if (= wd (calendar-day-of-week date)) (setq jst t))
      (setq wds (cdr wds))
      )
    jst))

(defun diary-every-day-in-month(y m &rest wds)
  (let* (
         (l     (calendar-last-day-of-month m y))
         (endd  (calendar-absolute-from-gregorian (list m l y)))
         (sttd  (calendar-absolute-from-gregorian (list m 1 y)))
         (today (calendar-absolute-from-gregorian date))
         (jst0  nil)
         (jst   nil)
         )
    (if (and (not (minusp (- today sttd)))
             (not (minusp (- endd  today))))
        (setq jst0 t))
    (if (and jst0 (not wds)) (setq jst  t)) ;; 毎日
    (if (and jst0 wds)       (setq jst (not (diary-habit-weekday-week date wds))))
    jst
   ))

(defun diary-monthly-meeting(stt end week num &optional exs &rest sbs)
  (let* (
         (doweek (calendar-day-of-week   date)) ;; 今日の曜日(1-7)
         (month  (calendar-extract-month date)) ;; 月(1-12)
         (sttd   (calendar-absolute-from-gregorian stt))
         (endd   (calendar-absolute-from-gregorian end))
         (today  (calendar-absolute-from-gregorian date))
         (diffs  (- today sttd))
         (diffe  (- endd  today))
         (ist    nil)
         (dst    nil)
         (mst    t)
         (sst    nil)
         (jst    nil) ;; 戻り値 t or nil
         )
    ;; 少なくとも今日が stt - end の間に無いと nil
    (if (and (not (minusp diffs)) (not (minusp diffe))) (setq ist t))
    ;; 毎月 num 週 week 曜日なら t
    (if (diary-float t week num) (setq dst t))
    ;; 除外月が指定されてて丁度その月なら nil
    (setq mst (diary-months-excepts month exs))
    ;; 普通の場合
    (setq jst (and ist dst mst))
    ;(y-or-n-p (message "ist=%s" ist))
    ;(y-or-n-p (message "dst=%s" dst))
    ;(y-or-n-p (message "mst=%s" mst))
    ;(y-or-n-p (message "jst=%s" jst))
    ;(if (and ist (and dst mst)) (setq jst t))
    ;; 今日が代わりの日であれば t
    (unless jst
      (setq jst (diary-lecture-substitution today sbs)))
    jst
    ))

(defun diary-months-excepts(month exs)
  (let ((mst t) (ex nil))
    (if exs
        (progn
          (while exs
            (setq ex (car exs))
            (if (= ex month) (setq mst nil))
            (setq exs (cdr exs))
            )
          )
      )
    mst))