功能如下: 需要先指定一个文件做为记录,里面需要手动写几个长久的任务,比如下图的Main。
执行函数后会让选择一个一级Heading作为记录的目标,再之后是让选择一个二级heading或者是输入一个新的,这里已Sub 1 为例。
之后就是进入新的buffer 作为记录,有一个 heading 和一些正文部分。 如下图所示:
完成编辑后按 C-c C-c 提交,提交之后就会连带当前的时间插入到最开始所选择的 org 文件中,如图所示:整个代码都是由大模型写的,目前读取二级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)