eh-org.el

   1 ;;; eh-org.el --- Tumashu's org-mode configuation    -*- lexical-binding: t; -*-
   2
   3 ;; * Header
   4 ;; Copyright (c) 2012-2016, Feng Shu
   5
   6 ;; Author: Feng Shu <tumashu@gmail.com>
   7 ;; URL: https://github.com/tumashu/emacs-helper
   8 ;; Version: 0.0.2
   9
  10 ;; This file is not part of GNU Emacs.
  11
  12 ;;; License:
  13
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License
  16 ;; as published by the Free Software Foundation; either version 3
  17 ;; of the License, or (at your option) any later version.
  18 ;;
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23 ;;
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  27 ;; Boston, MA 02110-1301, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; * 简介                                                  :README:
  32 ;;  这个文件是tumashu个人专用的emacs配置文件，emacs中文用户可以参考。
  33
  34 ;;; Code:
  35
  36 ;; * 代码                                                       :code:
  37
  38 ;; ** org
  39 (require 'org)
  40 (require 'org-attach)
  41 (require 'org-archive)
  42
  43 (add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
  44 (add-to-list 'auto-mode-alist '("\\.org_archive$" . org-mode))
  45
  46 (defvar eh-org-directory
  47   (expand-file-name
  48    (cl-find-if #'file-exists-p
  49                '("d:/org/"
  50                  "e:/org/"
  51                  "f:/org/"
  52                  "~/org/"
  53                  "~/storage/shared/org/"))))
  54
  55 ;; 这个附件设置只适合我自己，千万别乱抄。
  56 (setq org-attach-id-dir
  57       (concat (file-name-as-directory
  58                eh-org-directory)
  59               "data/"))
  60
  61 (dolist (f '(org-open-file))
  62   (advice-add f :around 'eh-find-file))
  63
  64 (setq org-todo-keywords
  65       '((type "TODO(t)" "|" "DONE(d!)" "CANCELED(c!)")))
  66
  67 (setq org-tags-exclude-from-inheritance
  68       '("proj"))
  69
  70 (setq org-tag-persistent-alist
  71       '(("proj")
  72         ("ref")
  73         ("ATTACH")))
  74
  75 (setq org-stuck-projects
  76       '("+proj/-DONE-CANCELED"
  77         ("TODO")
  78         nil ""))
  79
  80 (setq org-use-fast-tag-selection t)
  81 (setq org-complete-tags-always-offer-all-agenda-tags t)
  82
  83 (defun eh-org-fast-tag-selection (current _inherited table &optional _todo-table)
  84   (let* ((crm-separator "[      ]*[:,][         ]*")
  85          (current-tags (cl-copy-list current))
  86          (buf (current-buffer))
  87          (n (length current-tags))
  88          (max 5)
  89          (prompt (if (> n 0)
  90                      (format "Tag (%s%s): "
  91                              (mapconcat #'identity
  92                                         (cl-subseq current-tags 0 (min n max))
  93                                         ", ")
  94                              (if (> n max)
  95                                  " ..."
  96                                ""))
  97                    "Tag: "))
  98          tab-tags tags)
  99
 100     (condition-case nil
 101         (unless tab-tags
 102           (setq tab-tags
 103                 (delq nil
 104                       (mapcar (lambda (x)
 105                                 (let ((item (car-safe x)))
 106                                   (and (stringp item)
 107                                        (list item))))
 108                               (org--tag-add-to-alist
 109                                (with-current-buffer buf
 110                                  (org-get-buffer-tags))
 111                                table))))))
 112
 113     (setq tags (completing-read-multiple
 114                 prompt (mapcar
 115                         (lambda (x)
 116                           (if (member (car x) current-tags)
 117                               (cons (propertize (car x) 'face '(:box t)) (cdr x))
 118                             x))
 119                         tab-tags)))
 120
 121     (dolist (tg (delete-dups (remove "" tags)))
 122       (when (string-match "\\S-" tg)
 123         (if (member tg current-tags)
 124             (setq current-tags (delete tg current-tags))
 125           (push tg current-tags))))
 126     (org-make-tag-string current-tags)))
 127
 128 (advice-add 'org-fast-tag-selection :override #'eh-org-fast-tag-selection)
 129
 130 (defun eh-org-end-of-id-line ()
 131   (when (eq major-mode 'org-mode)
 132     (org-back-to-heading t)
 133     (org-id-get-create)
 134     (search-forward ":ID:")
 135     (end-of-line)
 136     (org-fold-show-all '(drawers))))
 137
 138 (setq org-insert-heading-respect-content nil)
 139 (setq org-log-done t)
 140 (setq org-startup-indented nil)
 141 (setq org-adapt-indentation 'headline-data)
 142 (setq org-edit-src-content-indentation 0)
 143 (setq org-id-link-to-org-use-id t)
 144 (setq org-log-into-drawer t)
 145
 146 ;; org 文件显示内嵌图片的时候，首先缩放一下。
 147 (setq org-image-actual-width t)
 148
 149 ;; 插入日期戳的命令不弹出日历表，太占地方。
 150 (setq org-read-date-popup-calendar nil)
 151
 152 (defun eh-org-refile-agenda-files ()
 153   (org-agenda-files t t))
 154
 155 (setq org-refile-targets
 156       '((nil . (:maxlevel . 1))
 157         (eh-org-refile-agenda-files . (:maxlevel . 1))))
 158
 159 (setq org-outline-path-complete-in-steps nil)
 160 (setq org-refile-allow-creating-parent-nodes 'confirm)
 161 (setq org-refile-use-outline-path 'file)
 162 (setq org-refile-active-region-within-subtree t)
 163
 164 (defun eh-org-fill-paragraph ()
 165   "Fill org paragraph"
 166   (interactive)
 167   (let ((fill-column 10000000))
 168     (org-fill-paragraph)))
 169
 170 (defun eh-org-ctrl-c-ctrl-c (&optional arg)
 171   "根据光标处内容，智能折行，比如，在表格中禁止折行。"
 172   (interactive "P")
 173   (let* ((context (org-element-context))
 174          (type (org-element-type context)))
 175     (pcase type
 176       ((or `table `table-cell `table-row `item `plain-list)
 177        (toggle-truncate-lines 1))
 178       (_ (toggle-truncate-lines -1))))
 179   (org-ctrl-c-ctrl-c arg))
 180
 181 (defun eh-org-smart-truncate-lines (&optional _arg)
 182   (interactive)
 183   (org-defkey org-mode-map "\C-c\C-c" 'eh-org-ctrl-c-ctrl-c))
 184
 185 (defun eh-org-visual-line-mode ()
 186   (interactive)
 187   (setq visual-line-fringe-indicators '(nil nil))
 188   (visual-line-mode)
 189   (if visual-line-mode
 190       (setq word-wrap nil)))
 191
 192 (add-hook 'org-mode-hook 'eh-org-visual-line-mode)
 193 (add-hook 'org-mode-hook 'eh-org-smart-truncate-lines)
 194
 195 (require 'autorevert)
 196 (add-hook 'org-mode-hook #'turn-on-auto-revert-mode)
 197
 198 ;; (require 'org-protocol)
 199
 200 ;; ** org-export
 201 (require 'ox-odt)
 202 (require 'ox-org)
 203 (require 'ox-ascii)
 204 (require 'ox-md)
 205 (require 'ox-html)
 206
 207 (setq org-export-default-language "zh-CN")
 208
 209 ;; org默认使用"_下标"来定义一个下标，使用"^上标"定义一个上标，
 210 ;; 但这种方式在中文环境中与下划线冲突。
 211 ;; 这里强制使用"_{下标}"来定义一个下标。"^{上标}"来定义一个上标。
 212 (setq org-export-with-sub-superscripts '{})
 213 (setq org-use-sub-superscripts '{})
 214
 215 ;;; ** export html
 216 (setq org-html-coding-system 'utf-8)
 217 (setq org-html-head-include-default-style t)
 218 (setq org-html-head-include-scripts t)
 219 (setq org-html-validation-link nil)
 220
 221 (defun eh-org-wash-text (text backend _info)
 222   "导出 org file 时，删除中文之间不必要的空格。"
 223   (when (org-export-derived-backend-p backend 'html)
 224     (let ((regexp "[[:multibyte:]]")
 225           (string text))
 226       ;; org-mode 默认将一个换行符转换为空格，但中文不需要这个空格，删除。
 227       (setq string
 228             (replace-regexp-in-string
 229              (format "\\(%s\\) *\n *\\(%s\\)" regexp regexp)
 230              "\\1\\2" string))
 231       ;; 删除粗体之后的空格
 232       (dolist (str '("</b>" "</code>" "</del>" "</i>"))
 233         (setq string
 234               (replace-regexp-in-string
 235                (format "\\(%s\\)\\(%s\\)[ ]+\\(%s\\)" regexp str regexp)
 236                "\\1\\2\\3" string)))
 237       ;; 删除粗体之前的空格
 238       (dolist (str '("<b>" "<code>" "<del>" "<i>" "<span class=\"underline\">"))
 239         (setq string
 240               (replace-regexp-in-string
 241                (format "\\(%s\\)[ ]+\\(%s\\)\\(%s\\)" regexp str regexp)
 242                "\\1\\2\\3" string)))
 243       string)))
 244
 245 (add-hook 'org-export-filter-headline-functions #'eh-org-wash-text)
 246 (add-hook 'org-export-filter-paragraph-functions #'eh-org-wash-text)
 247
 248 ;; ** org-bable设置
 249 (setq org-confirm-babel-evaluate nil)
 250 (setq org-src-fontify-natively t)
 251
 252 (defun eh-org-show-babel-image ()
 253   (when (not org-export-current-backend)
 254     (org-display-inline-images)))
 255
 256 (add-hook 'org-babel-after-execute-hook #'eh-org-show-babel-image)
 257
 258 ;; *** org babel other modules
 259 (require 'ob-org)
 260 (require 'ob-emacs-lisp)
 261 (require 'ob-python)
 262
 263 ;; ** org-archive
 264 ;; 日常情况下，使用 ARCHIVE TAG 来隐藏已经完成的任务，安全又方便。
 265 (setq org-archive-default-command 'org-archive-set-tag)
 266
 267 ;; 使用 org-archive-subtree 时，保持一级目录结构。
 268 (defun eh-org-archive-subtree (orig_func &rest args)
 269   (let* ((tags (org-get-tags))
 270          (location (org-archive--compute-location
 271                     (or (org-entry-get nil "ARCHIVE" 'inherit)
 272                         org-archive-location)))
 273          (archive-file (car location))
 274          (subheading-p (save-excursion
 275                          (org-back-to-heading)
 276                          (> (org-outline-level) 1)))
 277          (top-headline (car (org-get-outline-path t)))
 278          (org-archive-location
 279           (if subheading-p
 280               (concat (car (split-string org-archive-location "::"))
 281                       "::* "
 282                       top-headline)
 283             org-archive-location)))
 284     (apply orig_func args)
 285     (when (and subheading-p archive-file tags)
 286       (with-current-buffer (find-file-noselect archive-file)
 287         (save-excursion
 288           (while (org-up-heading-safe))
 289           (org-set-tags tags))))))
 290
 291 (advice-add 'org-archive-subtree :around #'eh-org-archive-subtree)
 292
 293 ;; ** org-attach
 294 (setq org-attach-file-list-property nil)
 295 (setq org-attach-store-link-p 'attached)
 296 (setq org-attach-sync-delete-empty-dir t)
 297
 298 (defun eh-org-attach-sync-all ()
 299   (interactive)
 300   (org-map-entries #'org-attach-sync)
 301   (org-align-tags 'all))
 302
 303 (defun eh-org-attach-reveal ()
 304   (interactive)
 305   (let (marker)
 306     (when (eq major-mode 'org-agenda-mode)
 307       (setq marker (or (get-text-property (point) 'org-hd-marker)
 308                        (get-text-property (point) 'org-marker)))
 309       (unless marker
 310         (error "No task in current line")))
 311     (save-excursion
 312       (when marker
 313         (set-buffer (marker-buffer marker))
 314         (goto-char marker))
 315       (org-back-to-heading t)
 316       (call-interactively 'org-attach-reveal))))
 317
 318 (defun eh-org-attach-subtree ()
 319   (interactive)
 320   (when (yes-or-no-p "确定将 subtree 转移到 attach 目录中？ ")
 321     (org-back-to-heading t)
 322     (let* ((case-fold-search nil)
 323            (org-export-with-tags t)
 324            (filename (expand-file-name
 325                       (concat
 326                        (org-element-property
 327                         :title (org-element-at-point))
 328                        "-"
 329                        (format-time-string "%Y%m%dT%H%M%S")
 330                        ".org")
 331                       (org-attach-dir t))))
 332       (org-export-to-file 'org filename nil t)
 333       (org-end-of-meta-data)
 334       (delete-region (point) (org-end-of-subtree t)))))
 335
 336 ;; ** org-capture
 337 (require 'org-capture)
 338 (global-set-key (kbd "C-c c") 'org-capture)
 339
 340 (setq org-capture-templates
 341       (let ((file (concat (file-name-as-directory eh-org-directory) "projects.org")))
 342         `(("n" "Note" entry (file ,file)
 343            "* %?
 344   :PROPERTIES:
 345   :created: %U
 346   :END:
 347
 348 %i")
 349           ("s" "Schedule" entry (file+headline ,file "待整理")
 350            "* TODO %?
 351   SCHEDULED: %t
 352   :PROPERTIES:
 353   :created: %U
 354   :END:
 355
 356 %i")
 357           ("d" "Deadline" entry (file+headline ,file "待整理")
 358            "* TODO %?
 359   DEADLINE: %t
 360   :PROPERTIES:
 361   :created: %U
 362   :END:
 363
 364 %i"))))
 365
 366 (defun eh-org-capture-note ()
 367   (interactive)
 368   (org-capture nil "n"))
 369
 370 (defun eh-org-capture-schedule ()
 371   (interactive)
 372   (org-capture nil "s"))
 373
 374 (defun eh-org-capture-refresh-agenda (&rest _)
 375   (when (eq major-mode 'org-agenda-mode)
 376     (eh-org-agenda-redo-all)))
 377
 378 (advice-add 'org-capture-finalize :after #'eh-org-capture-refresh-agenda)
 379 (advice-add 'org-capture-refile :after #'eh-org-capture-refresh-agenda)
 380
 381 ;; ** org-agenda
 382 (require 'org-agenda)
 383
 384 (global-set-key (kbd "C-c a") 'org-agenda)
 385 (define-key org-agenda-mode-map (kbd "SPC") 'org-agenda-switch-to)
 386 (define-key org-agenda-mode-map (kbd "i") 'org-agenda-switch-to)
 387 (define-key org-agenda-mode-map (kbd "g") 'eh-org-agenda-redo-all)
 388 (define-key org-agenda-mode-map (kbd "A") 'org-agenda-archive-default-with-confirmation)
 389
 390 (defun eh-org-agenda-kill ()
 391   (interactive)
 392   (call-interactively #'org-agenda-kill)
 393   (eh-org-agenda-redo-all))
 394
 395 (define-key org-agenda-mode-map (kbd "C-k") #'eh-org-agenda-kill)
 396 (define-key org-agenda-mode-map (kbd "k") #'eh-org-agenda-kill)
 397 (define-key org-agenda-mode-map (kbd "c") #'eh-org-capture-schedule)
 398 (define-key org-agenda-mode-map (kbd "C") #'eh-org-capture-note)
 399
 400 (define-key org-agenda-mode-map (kbd "h") 'ignore)
 401 (define-key org-agenda-mode-map (kbd "y") 'ignore)
 402 (define-key org-agenda-mode-map (kbd "a") 'ignore)
 403
 404 ;; 取消下面关于 archive 的快捷键，容易误操作
 405 (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'ignore)
 406 (org-defkey org-agenda-mode-map "\C-c\C-xa"    'ignore)
 407 (org-defkey org-agenda-mode-map "\C-c\C-xA"    'ignore)
 408 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'ignore)
 409 (org-defkey org-agenda-mode-map "$"            'ignore)
 410
 411 ;; 加快 agenda 启动速度
 412 (setq org-agenda-dim-blocked-tasks t)
 413 (setq org-agenda-inhibit-startup t)
 414
 415 ;; 我更习惯类似 google 的搜索方式。
 416 (setq org-agenda-search-view-always-boolean t)
 417 (setq org-agenda-search-view-force-full-words nil)
 418
 419 (add-to-list 'org-agenda-files eh-org-directory t)
 420 (add-to-list 'org-agenda-files (concat (file-name-as-directory eh-org-directory) "orgzly") t)
 421 (make-directory (concat (file-name-as-directory eh-org-directory) "orgzly") t)
 422
 423 (defun eh-revert-org-buffers ()
 424   "Refreshes all opened org buffers."
 425   (interactive)
 426   (dolist (buf (buffer-list))
 427     (with-current-buffer buf
 428       (when (and (buffer-file-name)
 429                  (string-match-p "org$" (buffer-file-name))
 430                  (file-exists-p (buffer-file-name))
 431                  (not (buffer-modified-p)))
 432         (revert-buffer t t t) )))
 433   (message "Refreshed all opened org files."))
 434
 435 (defun eh-org-agenda-redo-all (&optional arg)
 436   (interactive "P")
 437   (eh-revert-org-buffers)
 438   (funcall-interactively #'org-agenda-redo-all arg)
 439   (message (substitute-command-keys
 440             "刷新完成，记得按快捷键 '\\[org-save-all-org-buffers]' 来保存更改。")))
 441
 442 (setq org-agenda-span 'day)
 443 (setq org-agenda-window-setup 'current-window)
 444 (setq org-agenda-include-diary nil)
 445
 446 (setq org-agenda-todo-ignore-scheduled t)
 447 (setq org-agenda-todo-ignore-deadlines t)
 448
 449 (setq org-agenda-todo-list-sublevels t)
 450 (setq org-agenda-todo-ignore-scheduled t)
 451
 452 (setq org-agenda-breadcrumbs-separator " ~> ")
 453
 454 (setq org-agenda-prefix-format
 455       '((agenda  . " %i %-14:c%?-12t% s")
 456         (todo  . " %i %-14:c")
 457         (tags  . " %i %-14:c")
 458         (search . " %i %-14:c")))
 459
 460 (setq org-agenda-format-date 'eh-org-agenda-format-date-aligned)
 461
 462 (defun eh-org-agenda-format-date-aligned (date)
 463   (require 'cal-iso)
 464   (let* ((dayname (calendar-day-name date))
 465          (day (cadr date))
 466          (day-of-week (calendar-day-of-week date))
 467          (month (car date))
 468          (year (nth 2 date))
 469          (iso-week (org-days-to-iso-week
 470                     (calendar-absolute-from-gregorian date)))
 471          (cn-date (calendar-chinese-from-absolute
 472                    (calendar-absolute-from-gregorian date)))
 473          (cn-month (cl-caddr cn-date))
 474          (cn-day (cl-cadddr cn-date))
 475          (cn-month-name
 476           ["正月" "二月" "三月" "四月" "五月" "六月"
 477            "七月" "八月" "九月" "十月" "冬月" "腊月"])
 478          (cn-day-name
 479           ["初一" "初二" "初三" "初四" "初五" "初六" "初七" "初八" "初九" "初十"
 480            "十一" "十二" "十三" "十四" "十五" "十六" "十七" "十八" "十九" "二十"
 481            "廿一" "廿二" "廿三" "廿四" "廿五" "廿六" "廿七" "廿八" "廿九" "三十"
 482            "卅一" "卅二" "卅三" "卅四" "卅五" "卅六" "卅七" "卅八" "卅九" "卅十"])
 483          (extra (format "(%s%s%s%s%s)"
 484                         (if (or (eq org-agenda-current-span 'day)
 485                                 (= day-of-week 1)
 486                                 (= cn-day 1))
 487                             (aref cn-month-name (1-  (floor cn-month)))
 488                           "")
 489                         (if (or (= day-of-week 1)
 490                                 (= cn-day 1))
 491                             (if (integerp cn-month) "" "[闰]")
 492                           "")
 493                         (aref cn-day-name (1- cn-day))
 494                         (if (or (= day-of-week 1)
 495                                 (eq org-agenda-current-span 'day))
 496                             (let ((holiday (mapconcat #'identity (calendar-check-holidays date) ", ")))
 497                               (if (> (length holiday) 0)
 498                                   (concat ", " holiday)
 499                                 ""))
 500                           "")
 501                         (if (or (= day-of-week 1)
 502                                 (eq org-agenda-current-span 'day))
 503                             (format ", 第%02d周" iso-week)
 504                           ""))))
 505     (format "%04d-%02d-%02d %s %s"
 506             year month day dayname extra)))
 507
 508 (defun eh-org-agenda-jump-to-first-item ()
 509   ;; 用 (goto-char (point-min)) 不管用，我估计是切换 tab 的缘故。
 510   (let ((window (get-buffer-window org-agenda-buffer)))
 511     (when (windowp window)
 512       (set-window-point window (point-min))
 513       (org-agenda-next-item 1))))
 514
 515 (add-hook 'org-agenda-finalize-hook #'eh-org-agenda-jump-to-first-item 100)
 516
 517 ;; Org super agenda
 518 (require 'org-super-agenda)
 519 (setq org-super-agenda-unmatched-name "未分组")
 520 (setq org-super-agenda-groups
 521       '((:name "Today" :time-grid t)
 522         (:name "待整理" :tag "待整理")
 523         (;; :auto-parent 和 :auto-outline-path 无法很好的处理一级
 524          ;; headline, 这里首先将一级 headline 归类。
 525          :name "(ROOT)"
 526          :pred (lambda (item)
 527                  (org-super-agenda--when-with-marker-buffer
 528                    (org-super-agenda--get-marker item)
 529                    (equal (org-current-level) 1))))
 530         (:auto-parent t)))
 531
 532 (org-super-agenda-mode 1)
 533
 534 (cl-pushnew
 535  '("a" "[org-super-agenda] Agenda for current week or day." agenda ""
 536    ((org-agenda-remove-tags t)
 537     (org-super-agenda-header-separator "\n")
 538     (org-super-agenda-final-group-separator "\n")))
 539  org-agenda-custom-commands)
 540
 541 ;; org ql
 542 (require 'org-ql)
 543
 544 ;; 公文和协议
 545 (defun eh-org-update-all-headlines ()
 546   (interactive)
 547   (org-map-entries #'eh-org-update-headline))
 548
 549 (defun eh-org-update-headline ()
 550   (interactive)
 551   (eh-org-update-gongwen-headline)
 552   (eh-org-update-xieyi-headline))
 553
 554 (defun eh-org-update-gongwen-headline ()
 555   (interactive)
 556   (when (and (eq major-mode 'org-mode)
 557              (equal (org-entry-get (point) "CATEGORY")
 558                     "党政机关公文"))
 559     (let* ((title (org-entry-get (point) "标题"))
 560            (daizi (or (org-entry-get (point) "发文机关代字") ""))
 561            (year (or (org-entry-get (point) "年份") ""))
 562            (num (or (org-entry-get (point) "发文顺序号") ""))
 563            (data (or (org-entry-get (point) "成文日期") ""))
 564            (organization (org-entry-get (point) "发文机关标志"))
 565            (organization (if (= (length organization) 0)
 566                              "未知发文机关"
 567                            organization))
 568            (zihao1 (org-entry-get (point) "发文字号"))
 569            (zihao (cond ((and (> (length daizi) 0)
 570                               (> (length year) 0)
 571                               (> (length num) 0))
 572                          (format "%s〔%s〕%s号" daizi year num))
 573                         ;; 以前记录的一些公文信息，只记录字号，没有记录代字，年份和
 574                         ;; 顺序号。
 575                         ((> (length zihao1) 0)
 576                          (replace-regexp-in-string
 577                           (regexp-quote "]") "〕"
 578                           (replace-regexp-in-string
 579                            (regexp-quote "[") "〔"
 580                            zihao1)))
 581                         ((and (= (length daizi) 0)
 582                               (> (length data) 0))
 583                          (format "%s %s" organization data))
 584                         (t organization)))
 585            (prefix "[公文]"))
 586       (when (> (length title) 0)
 587         (when (and title (string-match-p "《" title))
 588           (setq title
 589                 (replace-regexp-in-string
 590                  "《" "〈"
 591                  (replace-regexp-in-string "》" "〉" title))))
 592         (org-id-get-create)
 593         (org-edit-headline
 594          (format "%s《%s》（%s）" prefix title zihao))
 595         (when (string-match-p "〔" zihao)
 596           (org-set-property "发文字号" zihao))))))
 597
 598 (defun eh-org-update-xieyi-headline ()
 599   (interactive)
 600   (when (and (eq major-mode 'org-mode)
 601              (equal (org-entry-get (point) "CATEGORY")
 602                     "协议或合同"))
 603     (let* ((project (org-entry-get (point) "项目或服务名称"))
 604            (weituo (or (org-entry-get (point) "委托方") ""))
 605            (chengjie (or (org-entry-get (point) "承接方") ""))
 606            (jiakuan (or (org-entry-get (point) "价款（元）") ""))
 607            (date (org-entry-get (point) "签署日期"))
 608            (prefix "[协议]"))
 609       (when (> (length project) 0)
 610         (org-id-get-create)
 611         (org-edit-headline
 612          (format "%s《%s》（%s %s %s %s）" prefix project weituo chengjie jiakuan date))))))
 613
 614 (add-hook 'write-file-functions #'eh-org-update-headline 100)
 615 (add-hook 'org-capture-prepare-finalize-hook #'eh-org-update-headline 100)
 616
 617 ;; * Footer
 618 (provide 'eh-org)
 619
 620 ;; Local Variables:
 621 ;; coding: utf-8-unix
 622 ;; End:
 623
 624 ;;; eh-org.el ends here