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    (or (cl-find-if #'file-exists-p
  49                    '("d:/org/"
  50                      "e:/org/"
  51                      "f:/org/"
  52                      "~/org/"
  53                      "~/storage/shared/org/"))
  54        "~/org/")))
  55
  56 ;; 这个附件设置只适合我自己，千万别乱抄。
  57 (setq org-attach-id-dir
  58       (concat (file-name-as-directory
  59                eh-org-directory)
  60               "data/"))
  61
  62 (dolist (f '(org-open-file))
  63   (advice-add f :around 'eh-find-file))
  64
  65 (setq org-todo-keywords
  66       '((type "TODO(t)" "|" "DONE(d!)" "CANCELED(c!)")))
  67
  68 (setq org-tags-exclude-from-inheritance
  69       '("proj"))
  70
  71 (setq org-tag-persistent-alist
  72       '(("proj")
  73         ("ref")
  74         ("ATTACH")))
  75
  76 (setq org-stuck-projects
  77       '("+proj/-DONE-CANCELED"
  78         ("TODO")
  79         nil ""))
  80
  81 (setq org-use-fast-tag-selection t)
  82 (setq org-complete-tags-always-offer-all-agenda-tags t)
  83
  84 (defun eh-org-fast-tag-selection (current _inherited table &optional _todo-table)
  85   (let* ((crm-separator "[      ]*[:,][         ]*")
  86          (current-tags (cl-copy-list current))
  87          (buf (current-buffer))
  88          (n (length current-tags))
  89          (max 5)
  90          (prompt (if (> n 0)
  91                      (format "Tag (%s%s): "
  92                              (mapconcat #'identity
  93                                         (cl-subseq current-tags 0 (min n max))
  94                                         ", ")
  95                              (if (> n max)
  96                                  " ..."
  97                                ""))
  98                    "Tag: "))
  99          tab-tags tags)
 100
 101     (condition-case nil
 102         (unless tab-tags
 103           (setq tab-tags
 104                 (delq nil
 105                       (mapcar (lambda (x)
 106                                 (let ((item (car-safe x)))
 107                                   (and (stringp item)
 108                                        (list item))))
 109                               (org--tag-add-to-alist
 110                                (with-current-buffer buf
 111                                  (org-get-buffer-tags))
 112                                table))))))
 113
 114     (setq tags (completing-read-multiple
 115                 prompt (mapcar
 116                         (lambda (x)
 117                           (if (member (car x) current-tags)
 118                               (cons (propertize (car x) 'face '(:box t)) (cdr x))
 119                             x))
 120                         tab-tags)))
 121
 122     (dolist (tg (delete-dups (remove "" tags)))
 123       (when (string-match "\\S-" tg)
 124         (if (member tg current-tags)
 125             (setq current-tags (delete tg current-tags))
 126           (push tg current-tags))))
 127     (org-make-tag-string current-tags)))
 128
 129 (advice-add 'org-fast-tag-selection :override #'eh-org-fast-tag-selection)
 130
 131 (defun eh-org-end-of-id-line ()
 132   (when (eq major-mode 'org-mode)
 133     (org-back-to-heading t)
 134     (org-id-get-create)
 135     (search-forward ":ID:")
 136     (end-of-line)
 137     (org-fold-show-all '(drawers))))
 138
 139 (setq org-insert-heading-respect-content nil)
 140 (setq org-log-done t)
 141 (setq org-startup-indented nil)
 142 (setq org-adapt-indentation 'headline-data)
 143 (setq org-edit-src-content-indentation 0)
 144 (setq org-id-link-to-org-use-id t)
 145 (setq org-log-into-drawer t)
 146
 147 ;; org 文件显示内嵌图片的时候，首先缩放一下。
 148 (setq org-image-actual-width t)
 149
 150 ;; 插入日期戳的命令不弹出日历表，太占地方。
 151 (setq org-read-date-popup-calendar nil)
 152
 153 (defun eh-org-refile-agenda-files ()
 154   (org-agenda-files t t))
 155
 156 (setq org-refile-targets
 157       '((nil . (:maxlevel . 1))
 158         (eh-org-refile-agenda-files . (:maxlevel . 1))))
 159
 160 (setq org-outline-path-complete-in-steps nil)
 161 (setq org-refile-allow-creating-parent-nodes 'confirm)
 162 (setq org-refile-use-outline-path 'file)
 163 (setq org-refile-active-region-within-subtree t)
 164
 165 (defun eh-org-fill-paragraph ()
 166   "Fill org paragraph"
 167   (interactive)
 168   (let ((fill-column 10000000))
 169     (org-fill-paragraph)))
 170
 171 (defun eh-org-ctrl-c-ctrl-c (&optional arg)
 172   "根据光标处内容，智能折行，比如，在表格中禁止折行。"
 173   (interactive "P")
 174   (let* ((context (org-element-context))
 175          (type (org-element-type context)))
 176     (pcase type
 177       ((or `table `table-cell `table-row `item `plain-list)
 178        (toggle-truncate-lines 1))
 179       (_ (toggle-truncate-lines -1))))
 180   (org-ctrl-c-ctrl-c arg))
 181
 182 (defun eh-org-smart-truncate-lines (&optional _arg)
 183   (interactive)
 184   (org-defkey org-mode-map "\C-c\C-c" 'eh-org-ctrl-c-ctrl-c))
 185
 186 (defun eh-org-visual-line-mode ()
 187   (interactive)
 188   (setq visual-line-fringe-indicators '(nil nil))
 189   (visual-line-mode)
 190   (if visual-line-mode
 191       (setq word-wrap nil)))
 192
 193 (add-hook 'org-mode-hook 'eh-org-visual-line-mode)
 194 (add-hook 'org-mode-hook 'eh-org-smart-truncate-lines)
 195
 196 (require 'autorevert)
 197 (add-hook 'org-mode-hook #'turn-on-auto-revert-mode)
 198
 199 ;; (require 'org-protocol)
 200
 201 ;; ** org-export
 202 (require 'ox-odt)
 203 (require 'ox-org)
 204 (require 'ox-ascii)
 205 (require 'ox-md)
 206 (require 'ox-html)
 207
 208 (setq org-export-default-language "zh-CN")
 209
 210 ;; org默认使用"_下标"来定义一个下标，使用"^上标"定义一个上标，
 211 ;; 但这种方式在中文环境中与下划线冲突。
 212 ;; 这里强制使用"_{下标}"来定义一个下标。"^{上标}"来定义一个上标。
 213 (setq org-export-with-sub-superscripts '{})
 214 (setq org-use-sub-superscripts '{})
 215
 216 ;;; ** export html
 217 (setq org-html-coding-system 'utf-8)
 218 (setq org-html-head-include-default-style t)
 219 (setq org-html-head-include-scripts t)
 220 (setq org-html-validation-link nil)
 221
 222 (defun eh-org-wash-text (text backend _info)
 223   "导出 org file 时，删除中文之间不必要的空格。"
 224   (when (org-export-derived-backend-p backend 'html)
 225     (let ((regexp "[[:multibyte:]]")
 226           (string text))
 227       ;; org-mode 默认将一个换行符转换为空格，但中文不需要这个空格，删除。
 228       (setq string
 229             (replace-regexp-in-string
 230              (format "\\(%s\\) *\n *\\(%s\\)" regexp regexp)
 231              "\\1\\2" string))
 232       ;; 删除粗体之后的空格
 233       (dolist (str '("</b>" "</code>" "</del>" "</i>"))
 234         (setq string
 235               (replace-regexp-in-string
 236                (format "\\(%s\\)\\(%s\\)[ ]+\\(%s\\)" regexp str regexp)
 237                "\\1\\2\\3" string)))
 238       ;; 删除粗体之前的空格
 239       (dolist (str '("<b>" "<code>" "<del>" "<i>" "<span class=\"underline\">"))
 240         (setq string
 241               (replace-regexp-in-string
 242                (format "\\(%s\\)[ ]+\\(%s\\)\\(%s\\)" regexp str regexp)
 243                "\\1\\2\\3" string)))
 244       string)))
 245
 246 (add-hook 'org-export-filter-headline-functions #'eh-org-wash-text)
 247 (add-hook 'org-export-filter-paragraph-functions #'eh-org-wash-text)
 248
 249 ;; ** org-bable设置
 250 (setq org-confirm-babel-evaluate nil)
 251 (setq org-src-fontify-natively t)
 252
 253 (defun eh-org-show-babel-image ()
 254   (when (not org-export-current-backend)
 255     (org-display-inline-images)))
 256
 257 (add-hook 'org-babel-after-execute-hook #'eh-org-show-babel-image)
 258
 259 ;; *** org babel other modules
 260 (require 'ob-org)
 261 (require 'ob-emacs-lisp)
 262 (require 'ob-python)
 263
 264 ;; ** org-archive
 265 ;; 日常情况下，使用 ARCHIVE TAG 来隐藏已经完成的任务，安全又方便。
 266 (setq org-archive-default-command 'org-archive-set-tag)
 267
 268 ;; 使用 org-archive-subtree 时，保持一级目录结构。
 269 (defun eh-org-archive-subtree (orig_func &rest args)
 270   (let* ((tags (org-get-tags))
 271          (location (org-archive--compute-location
 272                     (or (org-entry-get nil "ARCHIVE" 'inherit)
 273                         org-archive-location)))
 274          (archive-file (car location))
 275          (subheading-p (save-excursion
 276                          (org-back-to-heading)
 277                          (> (org-outline-level) 1)))
 278          (top-headline (car (org-get-outline-path t)))
 279          (org-archive-location
 280           (if subheading-p
 281               (concat (car (split-string org-archive-location "::"))
 282                       "::* "
 283                       top-headline)
 284             org-archive-location)))
 285     (apply orig_func args)
 286     (when (and subheading-p archive-file tags)
 287       (with-current-buffer (find-file-noselect archive-file)
 288         (save-excursion
 289           (while (org-up-heading-safe))
 290           (org-set-tags tags))))))
 291
 292 (advice-add 'org-archive-subtree :around #'eh-org-archive-subtree)
 293
 294 ;; ** org-attach
 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
 422 (when (file-writable-p "~")
 423   (make-directory (concat (file-name-as-directory eh-org-directory) "orgzly") t))
 424
 425 (defun eh-revert-org-buffers ()
 426   "Refreshes all opened org buffers."
 427   (interactive)
 428   (dolist (buf (buffer-list))
 429     (with-current-buffer buf
 430       (when (and (buffer-file-name)
 431                  (string-match-p "org$" (buffer-file-name))
 432                  (file-exists-p (buffer-file-name))
 433                  (not (buffer-modified-p)))
 434         (revert-buffer t t t) )))
 435   (message "Refreshed all opened org files."))
 436
 437 (defun eh-org-agenda-redo-all (&optional arg)
 438   (interactive "P")
 439   (eh-revert-org-buffers)
 440   (funcall-interactively #'org-agenda-redo-all arg)
 441   (message (substitute-command-keys
 442             "刷新完成，记得按快捷键 '\\[org-save-all-org-buffers]' 来保存更改。")))
 443
 444 (setq org-agenda-span 'day)
 445 (setq org-agenda-window-setup 'current-window)
 446 (setq org-agenda-include-diary nil)
 447
 448 (setq org-agenda-todo-ignore-scheduled t)
 449 (setq org-agenda-todo-ignore-deadlines t)
 450
 451 (setq org-agenda-todo-list-sublevels t)
 452 (setq org-agenda-todo-ignore-scheduled t)
 453
 454 (setq org-agenda-breadcrumbs-separator " ~> ")
 455
 456 (setq org-agenda-prefix-format
 457       '((agenda  . " %i %-14:c%?-12t% s")
 458         (todo  . " %i %-14:c")
 459         (tags  . " %i %-14:c")
 460         (search . " %i %-14:c")))
 461
 462 (setq org-agenda-format-date 'eh-org-agenda-format-date-aligned)
 463
 464 (defun eh-org-agenda-format-date-aligned (date)
 465   (require 'cal-iso)
 466   (let* ((dayname (calendar-day-name date))
 467          (day (cadr date))
 468          (day-of-week (calendar-day-of-week date))
 469          (month (car date))
 470          (year (nth 2 date))
 471          (iso-week (org-days-to-iso-week
 472                     (calendar-absolute-from-gregorian date)))
 473          (cn-date (calendar-chinese-from-absolute
 474                    (calendar-absolute-from-gregorian date)))
 475          (cn-month (cl-caddr cn-date))
 476          (cn-day (cl-cadddr cn-date))
 477          (cn-month-name
 478           ["正月" "二月" "三月" "四月" "五月" "六月"
 479            "七月" "八月" "九月" "十月" "冬月" "腊月"])
 480          (cn-day-name
 481           ["初一" "初二" "初三" "初四" "初五" "初六" "初七" "初八" "初九" "初十"
 482            "十一" "十二" "十三" "十四" "十五" "十六" "十七" "十八" "十九" "二十"
 483            "廿一" "廿二" "廿三" "廿四" "廿五" "廿六" "廿七" "廿八" "廿九" "三十"
 484            "卅一" "卅二" "卅三" "卅四" "卅五" "卅六" "卅七" "卅八" "卅九" "卅十"])
 485          (extra (format "(%s%s%s%s%s)"
 486                         (if (or (eq org-agenda-current-span 'day)
 487                                 (= day-of-week 1)
 488                                 (= cn-day 1))
 489                             (aref cn-month-name (1-  (floor cn-month)))
 490                           "")
 491                         (if (or (= day-of-week 1)
 492                                 (= cn-day 1))
 493                             (if (integerp cn-month) "" "[闰]")
 494                           "")
 495                         (aref cn-day-name (1- cn-day))
 496                         (if (or (= day-of-week 1)
 497                                 (eq org-agenda-current-span 'day))
 498                             (let ((holiday (mapconcat #'identity (calendar-check-holidays date) ", ")))
 499                               (if (> (length holiday) 0)
 500                                   (concat ", " holiday)
 501                                 ""))
 502                           "")
 503                         (if (or (= day-of-week 1)
 504                                 (eq org-agenda-current-span 'day))
 505                             (format ", 第%02d周" iso-week)
 506                           ""))))
 507     (format "%04d-%02d-%02d %s %s"
 508             year month day dayname extra)))
 509
 510 (defun eh-org-agenda-jump-to-first-item ()
 511   ;; 用 (goto-char (point-min)) 不管用，我估计是切换 tab 的缘故。
 512   (let ((window (get-buffer-window org-agenda-buffer)))
 513     (when (windowp window)
 514       (set-window-point window (point-min))
 515       (org-agenda-next-item 1))))
 516
 517 (add-hook 'org-agenda-finalize-hook #'eh-org-agenda-jump-to-first-item 100)
 518
 519 ;; Org super agenda
 520 (require 'org-super-agenda)
 521 (setq org-super-agenda-unmatched-name "未分组")
 522 (setq org-super-agenda-groups
 523       '((:name "Today" :time-grid t)
 524         (:name "待整理" :tag "待整理")
 525         (;; :auto-parent 和 :auto-outline-path 无法很好的处理一级
 526          ;; headline, 这里首先将一级 headline 归类。
 527          :name "(ROOT)"
 528          :pred (lambda (item)
 529                  (org-super-agenda--when-with-marker-buffer
 530                    (org-super-agenda--get-marker item)
 531                    (equal (org-current-level) 1))))
 532         (:auto-parent t)))
 533
 534 (org-super-agenda-mode 1)
 535
 536 (cl-pushnew
 537  '("a" "[org-super-agenda] Agenda for current week or day." agenda ""
 538    ((org-agenda-remove-tags t)
 539     (org-super-agenda-header-separator "\n")
 540     (org-super-agenda-final-group-separator "\n")))
 541  org-agenda-custom-commands)
 542
 543 ;; org ql
 544 (require 'org-ql)
 545
 546 ;; 公文和协议
 547 (defun eh-org-update-all-headlines ()
 548   (interactive)
 549   (org-map-entries #'eh-org-update-headline))
 550
 551 (defun eh-org-update-headline ()
 552   (interactive)
 553   (eh-org-update-gongwen-headline)
 554   (eh-org-update-xieyi-headline))
 555
 556 (defun eh-org-update-gongwen-headline ()
 557   (interactive)
 558   (when (and (eq major-mode 'org-mode)
 559              (equal (org-entry-get (point) "CATEGORY")
 560                     "党政机关公文"))
 561     (let* ((title (org-entry-get (point) "标题"))
 562            (daizi (or (org-entry-get (point) "发文机关代字") ""))
 563            (year (or (org-entry-get (point) "年份") ""))
 564            (num (or (org-entry-get (point) "发文顺序号") ""))
 565            (data (or (org-entry-get (point) "成文日期") ""))
 566            (organization (org-entry-get (point) "发文机关标志"))
 567            (organization (if (= (length organization) 0)
 568                              "未知发文机关"
 569                            organization))
 570            (zihao1 (org-entry-get (point) "发文字号"))
 571            (zihao (cond ((and (> (length daizi) 0)
 572                               (> (length year) 0)
 573                               (> (length num) 0))
 574                          (format "%s〔%s〕%s号" daizi year num))
 575                         ;; 以前记录的一些公文信息，只记录字号，没有记录代字，年份和
 576                         ;; 顺序号。
 577                         ((> (length zihao1) 0)
 578                          (replace-regexp-in-string
 579                           (regexp-quote "]") "〕"
 580                           (replace-regexp-in-string
 581                            (regexp-quote "[") "〔"
 582                            zihao1)))
 583                         ((and (= (length daizi) 0)
 584                               (> (length data) 0))
 585                          (format "%s %s" organization data))
 586                         (t organization)))
 587            (prefix "[公文]"))
 588       (when (> (length title) 0)
 589         (when (and title (string-match-p "《" title))
 590           (setq title
 591                 (replace-regexp-in-string
 592                  "《" "〈"
 593                  (replace-regexp-in-string "》" "〉" title))))
 594         (org-id-get-create)
 595         (org-edit-headline
 596          (format "%s《%s》（%s）" prefix title zihao))
 597         (when (string-match-p "〔" zihao)
 598           (org-set-property "发文字号" zihao))))))
 599
 600 (defun eh-org-update-xieyi-headline ()
 601   (interactive)
 602   (when (and (eq major-mode 'org-mode)
 603              (equal (org-entry-get (point) "CATEGORY")
 604                     "协议或合同"))
 605     (let* ((project (org-entry-get (point) "项目或服务名称"))
 606            (weituo (or (org-entry-get (point) "委托方") ""))
 607            (chengjie (or (org-entry-get (point) "承接方") ""))
 608            (jiakuan (or (org-entry-get (point) "价款（元）") ""))
 609            (date (org-entry-get (point) "签署日期"))
 610            (prefix "[协议]"))
 611       (when (> (length project) 0)
 612         (org-id-get-create)
 613         (org-edit-headline
 614          (format "%s《%s》（%s %s %s %s）" prefix project weituo chengjie jiakuan date))))))
 615
 616 (add-hook 'write-file-functions #'eh-org-update-headline 100)
 617 (add-hook 'org-capture-prepare-finalize-hook #'eh-org-update-headline 100)
 618
 619 ;; * Footer
 620 (provide 'eh-org)
 621
 622 ;; Local Variables:
 623 ;; coding: utf-8-unix
 624 ;; End:
 625
 626 ;;; eh-org.el ends here