分享一个在长线任务中记录自己的随时间的行动的elisp函数

功能如下: 需要先指定一个文件做为记录,里面需要手动写几个长久的任务,比如下图的Main。

image

执行函数后会让选择一个一级Heading作为记录的目标,再之后是让选择一个二级heading或者是输入一个新的,这里已Sub 1 为例。

之后就是进入新的buffer 作为记录,有一个 heading 和一些正文部分。 如下图所示:

完成编辑后按 C-c C-c 提交,提交之后就会连带当前的时间插入到最开始所选择的 org 文件中,如图所示: image

整个代码都是由大模型写的,目前读取二级Heanding的函数无法正常工作,只能手动输入。

(defvar yt/work-log-buffer "*Work Log*"
  "Buffer name for entering work log details.")

(defvar yt/work-log-file nil
  "File to save the work log.")

(defvar yt/work-log-main-heading nil
  "Main heading for the work log.")

(defvar yt/work-log-sub-heading nil
  "Sub-heading for the work log.")

(defun yt/log-work ()
  "Log work in the specified org file."
  (interactive)
  (let* ((file (concat org-roam-directory "/DivineAscent.org"))
         (headings (yt/get-headings file))
         (main-heading (completing-read "Choose main heading: " headings))
         (sub-headings (yt/get-second-level-headings file main-heading))
         (sub-heading (completing-read "Choose sub-heading or enter new one: " sub-headings))
         (existing-sub-heading (yt/find-existing-sub-heading file main-heading sub-heading)))
    (setq yt/work-log-file file
          yt/work-log-main-heading main-heading
          yt/work-log-sub-heading (or existing-sub-heading sub-heading))
    (yt/prepare-log-buffer)))

(defun yt/prepare-log-buffer ()
  "Prepare a buffer for entering work log details."
  (switch-to-buffer (get-buffer-create yt/work-log-buffer))
  (erase-buffer)
  (org-mode)
  (insert (format "Work Log for %s%s\n\n" 
                  yt/work-log-main-heading 
                  (if (string-empty-p yt/work-log-sub-heading) 
                      "" 
                    (concat " > " yt/work-log-sub-heading))))
  (insert "Enter your work title and log details below. Press C-c C-c when done.\n\n")
  (insert "* \n\n")
  (previous-line 2)
  (end-of-line)
  (use-local-map (copy-keymap org-mode-map))
  (local-set-key (kbd "C-c C-c") 'yt/save-work-log))

(defun yt/save-work-log ()
  "Save the work log to the specified file."
  (interactive)
  (let* ((content (buffer-substring-no-properties (point-min) (point-max)))
         (title-and-body (yt/extract-title-and-body content))
         (title (car title-and-body))
         (body (cdr title-and-body))
         (timestamp (format-time-string "[%Y-%m-%d %H:%M] ")))
    (with-current-buffer (find-file-noselect yt/work-log-file)
      (save-excursion
        (goto-char (point-min))
        (re-search-forward (concat "^\\* " (regexp-quote yt/work-log-main-heading)))
        (let ((main-level (org-outline-level)))
          (if (not (string-empty-p yt/work-log-sub-heading))
              (progn
                (yt/ensure-sub-heading main-level yt/work-log-sub-heading)
                (org-end-of-subtree)
                (newline)
                (insert (make-string (+ 2 main-level) ?*) " " timestamp title "\n")
                (when body
                  (insert body "\n")))
            (org-end-of-subtree)
            (newline)
            (insert (make-string (1+ main-level) ?*) " " timestamp title "\n")
            (when body
              (insert body "\n")))))
      (save-buffer)))
  (kill-buffer yt/work-log-buffer)
  (message "Work log added successfully!"))

(defun yt/ensure-sub-heading (main-level sub-heading)
  "Ensure the sub-heading exists, create if it doesn't."
  (unless (re-search-forward (concat "^" (make-string (1+ main-level) ?*) " " (regexp-quote sub-heading)) nil t)
    (org-end-of-subtree)
    (newline)
    (insert (make-string (1+ main-level) ?*) " " sub-heading)))

(defun yt/extract-title-and-body (content)
  "Extract the title and body from the log content."
  (with-temp-buffer
    (insert content)
    (goto-char (point-min))
    (re-search-forward "^\\* \\(.*\\)" nil t)
    (let ((title (match-string 1)))
      (forward-line)
      ;(re-search-forward "Enter your work log details below.*\n\n")
      (let ((body (buffer-substring-no-properties (point) (point-max))))
        (cons (if (string-empty-p title) "Untitled" title)
              (if (string-empty-p body) nil (string-trim body)))))))

(defun yt/get-headings (file)
  "Get all top-level headings from the specified org file."
  (with-current-buffer (find-file-noselect file)
    (org-map-entries 
     (lambda () 
       (when (= (org-outline-level) 1)
         (org-get-heading t t t t)))
     t 'file)))

(defun yt/get-second-level-headings (file top-level-heading)
  "Get all second-level headings under the specified top-level heading from the given org file."
  (with-current-buffer (find-file-noselect file)
    (goto-char (point-min))
    (let ((headings '()))
      (when (re-search-forward (format "^\\* %s$" (regexp-quote top-level-heading)) nil t)
        ;; We found the top-level heading, now collect second-level headings
        (let ((top-level-end (save-excursion
                               (outline-next-heading)
                               (point))))
          (goto-char (point))
          (while (and (re-search-forward "^\\*\\* \\(.*\\)" top-level-end t)
                      (<= (org-outline-level) 2))
            (push (match-string 1) headings))))
      (nreverse headings))))

(defun yt/find-existing-sub-heading (file main-heading sub-heading)
  "Check if the sub-heading already exists under the main heading."
  (with-current-buffer (find-file-noselect file)
    (save-excursion
      (goto-char (point-min))
      (when (re-search-forward (concat "^\\* " (regexp-quote main-heading)) nil t)
        (let ((main-level (org-outline-level)))
          (when (re-search-forward (concat "^" (make-string (1+ main-level) ?*) " " (regexp-quote sub-heading)) nil t)
            sub-heading))))))

;; 为函数绑定快捷键(可选)
(global-set-key (kbd "C-c l") 'yt/log-work)

2 个赞
1 个赞

厉害,果然多来论坛交流是正确的