Lập trình thêm sinh nhật / ngày lễ vào chế độ xem chương trình nghị sự ở chế độ tổ chức

org-modecung cấp một vài tùy chọn tích hợp để thêm ngày sinh nhật / ngày lễ vào giao diện chương trình nghị sự trong org-mode; tuy nhiên, không có hỗ trợ tích hợp để thêm các ngày đó hoàn toàn theo chương trình - mà không cần thêm thủ công các mục nhật ký hoặc mục trong tệp org tiêu chuẩn.

http://orgmode.org/manual/Weekly_002fdaily-agenda.html

Có cách nào để thêm ngày sinh nhật / ngày lễ vào giao diện chương trình nghị sự, tương tự như những gì calendar-modecung cấp không? Trong calendar-mode, người dùng có thể xác định ngày lễ và ngày sinh nhật với một biến kết hợp với các chức năng như holiday-fixedvà holiday-float. Các loại thiết lập tương tự cho org-modecó vẻ hữu ích.

Sau đây là sửa đổi org-agenda-list, với các biến mới bổ sung và chức năng mới để thêm ngày lễ / sinh nhật. Khi nào org-agenda--show-holidays-birthdayskhông nil, sinh nhật và ngày lễ sẽ xuất hiện theo chương trình trong chế độ xem chương trình nghị sự. Các biến org-agenda--birthday-listvà org-agenda--holiday-listcó thể được tùy chỉnh bởi người dùng. Một mục đã được thêm vào để org-agenda-custom-commandsdùng thử tính năng mới này - chữ in hoa "Y" khởi chạy chế độ xem năm có chứa ngày lễ / sinh nhật. Một số chức năng giới hạn đã được thêm vào để hỗ trợ một số thuộc tính văn bản cơ bản và những thuộc tính khác có thể được thêm vào sau.

Để biết ví dụ về cách định dạng ngày lễ và ngày sinh được sử dụng trong các biến được đề cập ở trên, vui lòng tham khảo chuỗi doc cho biến calendar-holidaystrong thư viện holidays.el- ví dụ : holiday-fixed; holiday-float; holiday-sexp; (lunar-phases); (solar-equinoxes-solstices); holiday-hebrew; holiday-islamic; holiday-bahai; holiday-julian; holiday-chinese; Vân vân.

Làm thế nào bạn có thể thử ví dụ này? : Chặn / sao chép / dán mã vào *Scratch*bộ đệm của bạn ; và loại M-x eval-buffer RET; và sau đó nhập M-x org-agenda RETvà sau đó chọn chữ viết hoa Y. Đây là một bản nháp hoạt động đầy đủ chức năng, nhưng cần một chút tùy chỉnh để làm cho nó đẹp hơn và thêm khả năng sắp xếp theo thứ tự abc, v.v ... Nếu bạn quyết định rằng bạn không thích nó sau khi thử, hãy khởi động lại Emacs và bạn sẽ quay lại đến nơi bạn đã ở trước khi bạn thử nó.

Mã nguồn đã được sửa đổi và thử nghiệm đã được thực hiện với phiên bản phát hành công khai gần đây nhất của Emacs:   Org-mode phiên bản 8.2.10 (release_8.2.10 @ /Appluggest/Emacs.app/Contents/Resource/lisp/org /) ; và, GNU Emacs 24.4.1 (x86_64-apple-darwin10.8.0, NS apple-appkit-1038.36) của 2014-10-20 trên builder10-6.porkrind.org .

MẬT MÃ:

(require 'org-agenda)
(require 'holidays)

(add-to-list 'org-agenda-custom-commands '(
  "Y" "365 Days -- holidays/birthdays" agenda "Year View" (
  (org-agenda-span 365)
  (org-agenda-time-grid nil)
  (org-agenda--show-holidays-birthdays t) )))

(defcustom org-agenda--show-holidays-birthdays nil
  "When non-`nil`, show holidays/birthdays in the agenda view."
  :group 'holidays)

(defcustom org-agenda--birthday-list (mapcar 'purecopy '(
  (holiday-fixed 1 2 "Jane Doe -- 01/02/1940")
  (holiday-fixed 2 15 "John Doe -- 02/15/1963")
  (holiday-fixed 3 2 "Seymoure Hersh -- 03/03/1999")
  (holiday-fixed 3 3 "Jashua Smith -- 03/03/1964")
  (holiday-fixed 3 5 "Frederick Holmes -- 03/05/1966")
  (holiday-fixed 4 7 "Fannie Mae -- 04/07/1970")
  (holiday-fixed 4 25 "Freddie Mack -- 04/25/1952")
  (holiday-float 5 0 2 "Mother's Day -- the second Sunday in May")
  (holiday-fixed 5 11 "George Lucas -- 05/11/1976")
  (holiday-fixed 5 18 "Harry Potter -- 05/18")
  (holiday-fixed 5 30 "Darth Vader -- 05/30/1972")
  (holiday-fixed 6 7 "Jabba the Hut -- 06/07/2007")
  (holiday-fixed 6 19 "Princess Lea -- 06/19/1983")
  (holiday-fixed 7 14 "Super Man -- 07/14/1970")
  (holiday-fixed 7 18 "Wonder Woman -- 07/18/1993")
  (holiday-fixed 10 3 "Jenifer Lopez (DOB:  10/03/2011)")
  (holiday-fixed 10 8 "Samuel Jacks (10/08/1965)")
  (holiday-fixed 10 25 "C3PO -- 10/25/2007")
  (holiday-fixed 11 14 "R2D2 -- 11/14/1981")
  (holiday-fixed 12 21 "Yoda -- 12/21/1958")
  (holiday-fixed 12 22 "Wookie -- 12/22/1967") ))
  "Birthdays."
  :type 'sexp
  :group 'holidays)

(defcustom org-agenda--holiday-list (mapcar 'purecopy '(
  (holiday-fixed 1 1 "New Year's Day")
  (holiday-float 1 1 3 "Martin Luther King Day")
  (holiday-float 2 1 3 "President's Day")
  (holiday-float 5 1 -1 "Memorial Day")
  (holiday-fixed 7 4 "Independence Day")
  (holiday-float 9 1 1 "Labor Day")
  (holiday-float 10 1 2 "Columbus Day")
  (holiday-fixed 11 11 "Veteran's Day")
  (holiday-float 11 4 4 "Thanksgiving")
  (holiday-fixed 12 25 "Christmas")
  (solar-equinoxes-solstices)
  (holiday-sexp calendar-daylight-savings-starts
    (format "Daylight Saving Time Begins %s"
      (solar-time-string
        (/ calendar-daylight-savings-starts-time (float 60))
        calendar-standard-time-zone-name)))
  (holiday-sexp calendar-daylight-savings-ends
      (format "Daylight Saving Time Ends %s"
       (solar-time-string
         (/ calendar-daylight-savings-ends-time (float 60))
         calendar-daylight-time-zone-name))) ))
  "Custom holidays defined by the user."
  :type 'sexp
  :group 'holidays)

(defface org-agenda--holiday-face
  '((t (:foreground "red")))
  "Face for `org-agenda--holiday-face`."
  :group 'org-agenda)

(defface org-agenda--birthday-face
  '((t (:foreground "magenta")))
  "Face for `org-agenda--birthday-face`."
  :group 'org-agenda)

(defun org-agenda-list (&optional arg start-day span with-hour)
  "Produce a daily/weekly view from all files in variable `org-agenda-files'.
The view will be for the current day or week, but from the overview buffer
you will be able to go to other days/weeks.

With a numeric prefix argument in an interactive call, the agenda will
span ARG days.  Lisp programs should instead specify SPAN to change
the number of days.  SPAN defaults to `org-agenda-span'.

START-DAY defaults to TODAY, or to the most recent match for the weekday
given in `org-agenda-start-on-weekday'.

When WITH-HOUR is non-nil, only include scheduled and deadline
items if they have an hour specification like [h]h:mm."
  (interactive "P")
  (if org-agenda-overriding-arguments
      (setq arg (car org-agenda-overriding-arguments)
      start-day (nth 1 org-agenda-overriding-arguments)
      span (nth 2 org-agenda-overriding-arguments)))
  (if (and (integerp arg) (> arg 0))
      (setq span arg arg nil))
  (catch 'exit
    (setq org-agenda-buffer-name
    (or org-agenda-buffer-tmp-name
        (if org-agenda-sticky
      (cond ((and org-keys (stringp org-match))
       (format "*Org Agenda(%s:%s)*" org-keys org-match))
      (org-keys
       (format "*Org Agenda(%s)*" org-keys))
      (t "*Org Agenda(a)*")))
        org-agenda-buffer-name))
    (org-agenda-prepare "Day/Week")
    (setq start-day (or start-day org-agenda-start-day))
    (if (stringp start-day)
  ;; Convert to an absolute day number
  (setq start-day (time-to-days (org-read-date nil t start-day))))
    (org-compile-prefix-format 'agenda)
    (org-set-sorting-strategy 'agenda)
    (let* ((span (org-agenda-ndays-to-span
      (or span org-agenda-ndays org-agenda-span)))
     (today (org-today))
     (sd (or start-day today))
     (ndays (org-agenda-span-to-ndays span sd))
     (org-agenda-start-on-weekday
      (if (or (eq ndays 7) (eq ndays 14))
    org-agenda-start-on-weekday))
     (thefiles (org-agenda-files nil 'ifmode))
     (files thefiles)
     (start (if (or (null org-agenda-start-on-weekday)
        (< ndays 7))
          sd
        (let* ((nt (calendar-day-of-week
        (calendar-gregorian-from-absolute sd)))
         (n1 org-agenda-start-on-weekday)
         (d (- nt n1)))
          (- sd (+ (if (< d 0) 7 0) d)))))
     (day-numbers (list start))
     (day-cnt 0)
     (inhibit-redisplay (not debug-on-error))
     (org-agenda-show-log-scoped org-agenda-show-log)
     s e rtn rtnall file date d start-pos end-pos todayp
     clocktable-start clocktable-end filter)
      (setq org-agenda-redo-command
      (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
      (dotimes (n (1- ndays))
  (push (1+ (car day-numbers)) day-numbers))
      (setq day-numbers (nreverse day-numbers))
      (setq clocktable-start (car day-numbers)
      clocktable-end (1+ (or (org-last day-numbers) 0)))
      (org-set-local 'org-starting-day (car day-numbers))
      (org-set-local 'org-arg-loc arg)
      (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
      (unless org-agenda-compact-blocks
  (let* ((d1 (car day-numbers))
         (d2 (org-last day-numbers))
         (w1 (org-days-to-iso-week d1))
         (w2 (org-days-to-iso-week d2)))
    (setq s (point))
    (if org-agenda-overriding-header
        (insert (org-add-props (copy-sequence org-agenda-overriding-header)
        nil 'face 'org-agenda-structure) "\n")
      (insert (org-agenda-span-name span)
        "-agenda"
        (if (< (- d2 d1) 350)
      (if (= w1 w2)
          (format " (W%02d)" w1)
        (format " (W%02d-W%02d)" w1 w2))
          "")
        ":\n")))
  (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
              'org-date-line t))
  (org-agenda-mark-header-line s))
      (while (setq d (pop day-numbers))
  (setq date (calendar-gregorian-from-absolute d)
        s (point))
  (if (or (setq todayp (= d today))
    (and (not start-pos) (= d sd)))
      (setq start-pos (point))
    (if (and start-pos (not end-pos))
        (setq end-pos (point))))
  (setq files thefiles
        rtnall nil)
  (while (setq file (pop files))
    (catch 'nextfile
      (org-check-agenda-file file)
      (let ((org-agenda-entry-types org-agenda-entry-types))
        ;; Starred types override non-starred equivalents
        (when (member :deadline* org-agenda-entry-types)
    (setq org-agenda-entry-types
          (delq :deadline org-agenda-entry-types)))
        (when (member :scheduled* org-agenda-entry-types)
    (setq org-agenda-entry-types
          (delq :scheduled org-agenda-entry-types)))
        ;; Honor with-hour
        (when with-hour
    (when (member :deadline org-agenda-entry-types)
      (setq org-agenda-entry-types
      (delq :deadline org-agenda-entry-types))
      (push :deadline* org-agenda-entry-types))
    (when (member :scheduled org-agenda-entry-types)
      (setq org-agenda-entry-types
      (delq :scheduled org-agenda-entry-types))
      (push :scheduled* org-agenda-entry-types)))
        (unless org-agenda-include-deadlines
    (setq org-agenda-entry-types
          (delq :deadline* (delq :deadline org-agenda-entry-types))))
        (cond
         ((memq org-agenda-show-log-scoped '(only clockcheck))
    (setq rtn (org-agenda-get-day-entries
         file date :closed)))
         (org-agenda-show-log-scoped
    (setq rtn (apply 'org-agenda-get-day-entries
         file date
         (append '(:closed) org-agenda-entry-types))))
         (t
    (setq rtn (apply 'org-agenda-get-day-entries
         file date
         org-agenda-entry-types)))))
      (setq rtnall (append rtnall rtn)))) ;; all entries
  (if org-agenda-include-diary
      (let ((org-agenda-search-headline-for-time t))
        (require 'diary-lib)
        (setq rtn (org-get-entries-from-diary date))
        (setq rtnall (append rtnall rtn))))
  ;; BEGIN -- MODIFICATION
  (when org-agenda--show-holidays-birthdays
    (setq rtn (org-agenda--get-birthdays-holidays))
    (setq rtnall (append rtnall rtn)))
  ;; END -- MODIFICATION
  (if (or rtnall org-agenda-show-all-dates)
      (progn
        (setq day-cnt (1+ day-cnt))
        (insert
         (if (stringp org-agenda-format-date)
       (format-time-string org-agenda-format-date
               (org-time-from-absolute date))
     (funcall org-agenda-format-date date))
         "\n")
        (put-text-property s (1- (point)) 'face
         (org-agenda-get-day-face date))
        (put-text-property s (1- (point)) 'org-date-line t)
        (put-text-property s (1- (point)) 'org-agenda-date-header t)
        (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
        (when todayp
    (put-text-property s (1- (point)) 'org-today t))
        (setq rtnall
        (org-agenda-add-time-grid-maybe rtnall ndays todayp))
        (if rtnall (insert ;; all entries
        (org-agenda-finalize-entries rtnall 'agenda)
        "\n"))
        (put-text-property s (1- (point)) 'day d)
        (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
      (when (and org-agenda-clockreport-mode clocktable-start)
  (let ((org-agenda-files (org-agenda-files nil 'ifmode))
        ;; the above line is to ensure the restricted range!
        (p (copy-sequence org-agenda-clockreport-parameter-plist))
        tbl)
    (setq p (org-plist-delete p :block))
    (setq p (plist-put p :tstart clocktable-start))
    (setq p (plist-put p :tend clocktable-end))
    (setq p (plist-put p :scope 'agenda))
    (setq tbl (apply 'org-clock-get-clocktable p))
    (insert tbl)))
      (goto-char (point-min))
      (or org-agenda-multi (org-agenda-fit-window-to-buffer))
      (unless (and (pos-visible-in-window-p (point-min))
       (pos-visible-in-window-p (point-max)))
  (goto-char (1- (point-max)))
  (recenter -1)
  (if (not (pos-visible-in-window-p (or start-pos 1)))
      (progn
        (goto-char (or start-pos 1))
        (recenter 1))))
      (goto-char (or start-pos 1))
      (add-text-properties (point-min) (point-max)
         `(org-agenda-type agenda
               org-last-args (,arg ,start-day ,span)
               org-redo-cmd ,org-agenda-redo-command
               org-series-cmd ,org-cmd))
      (if (eq org-agenda-show-log-scoped 'clockcheck)
    (org-agenda-show-clocking-issues))
      (org-agenda-finalize)
      (setq buffer-read-only t)
      (message ""))))

(defun org-agenda--get-birthdays-holidays ()
  "Add holidays/birthdays to the agenda view."
  (let* (
      (props (list
        'mouse-face 'highlight
        'org-not-done-regexp org-not-done-regexp
        'org-todo-regexp org-todo-regexp
        'org-complex-heading-regexp org-complex-heading-regexp
        'help-echo "Birthdays and Holidays"))
      (d1 (calendar-absolute-from-gregorian date))
      ee
      res-holidays
      res-birthdays
      (displayed-month (nth 0 date))
      (displayed-year (nth 2 date))
      (holiday-list
        (dolist (p org-agenda--holiday-list res-holidays)
          (let* (h)
           (when (setq h (eval p))
             (setq res-holidays (append h res-holidays))))))
      (birthday-list
        (dolist (p org-agenda--birthday-list res-birthdays)
          (let* (h)
           (when (setq h (eval p))
             (setq res-birthdays (append h res-birthdays)))))) )
    (when org-agenda--show-holidays-birthdays
      (mapcar
        (lambda (x)
          (let ((txt (format "%s -- holiday -- %s" (car x) (car (cdr x)))))
            (when (eq d1 (calendar-absolute-from-gregorian (car x)))
              (org-add-props txt props
                'ts-date d1
                ;; (char-to-string 65) = A; 66 = B; 67 = C; 68 = D; 69 = E
                'priority 65
                'type "holiday"
                'date d1
                'face 'org-agenda--holiday-face
                 ;; RESERVED FOR POTENTIAL FUTURE USE.
                'org-hd-marker nil
                'org-marker nil
                'warntime nil
                'level nil
                'org-category nil
                'org-category-position nil
                'todo-state nil
                'undone-face nil
                'done-face nil)
              (push txt ee))))
        holiday-list)
      (mapcar
        (lambda (x)
          (let ((txt (format "%s -- birthday -- %s" (car x) (car (cdr x)))))
            (when (eq d1 (calendar-absolute-from-gregorian (car x)))
              (org-add-props txt props
                'ts-date d1
                ;; (char-to-string 65) = A; 66 = B; 67 = C; 68 = D; 69 = E
                'priority 65
                'type "birthday"
                'date d1
                'face 'org-agenda--birthday-face
                 ;; RESERVED FOR POTENTIAL FUTURE USE.
                'org-hd-marker nil
                'org-marker nil
                'warntime nil
                'level nil
                'org-category nil
                'org-category-position nil
                'todo-state nil
                'undone-face nil
                'done-face nil)
              (push txt ee))))
        birthday-list))
    (nreverse ee)))