path: root/org-conf.el

;;; -*- lexical-binding: t; -*-

(setq org-latex-packages-alist '(("" "amsfonts" t))
      ;; org-format-latex-options (plist-put org-format-latex-options :scale 1.5)
      )

(setq org-adapt-indentation nil)
(setq org-modules '(ol-gnus ol-info ol-eww))

(setq org-hide-emphasis-markers nil)
(setq org-hide-macro-markers nil)
(setq org-hide-leading-stars nil)
(setq org-return-follows-link t)

;; tempo

(require 'org-tempo)

(add-to-list 'org-structure-template-alist (cons "g" "src durand-greek"))
(add-to-list 'org-structure-template-alist (cons "el" "src emacs-lisp"))
;; (add-to-list 'org-modules 'ol-gnus)

;;; Keys

(define-key global-map (vector 3 97) #'org-agenda)
(define-key global-map (vector 3 99) #'org-capture)
(define-key global-map (vector 3 ?l) #'org-store-link)

(define-key org-mode-map (vector ?\C-') nil)
(define-key org-mode-map (vector ?\C-,) nil)
(define-key org-mode-map (vector 'C-return) nil)
(define-key org-mode-map (vector 'C-S-return) nil)
(define-key org-mode-map (vector 3 ?\S-l) #'org-toggle-link-display)
(define-key org-mode-map (vector 3 ?\C-\S-l) #'org-insert-last-stored-link)

(declare-function 'durand-pulse-pulse-line "~/.emacs.d/basic.el")

(add-hook 'org-follow-link-hook #'durand-pulse-recenter-top)

;;; Some variables

(setq org-todo-keywords
      '((sequence "TODO(t)" "START(s)" "WORKING(w)" "HARD-WORKING(h)" "ALMOST(a)" "|" "DONE(d)")
        (sequence "TO-THINK(c)" "PENDING(p)" "HARD(r)" "IMPOSSIBLE(i)" "|" "SOLVED(v)"))
      org-tags-column -110
      org-hide-emphasis-markers t
      org-special-ctrl-a/e nil
      org-highlight-latex-and-related '(native latex script entities)
      org-agenda-files (mapcar (lambda (fn) (expand-file-name fn org-directory))
			       (list "notes.org"
				     "agenda.org"
				     "aujourdhui.org"
				     "math_article_links.org"))
      org-log-into-drawer t
      org-highest-priority ?A
      org-lowest-priority ?E
      org-default-priority ?B
      org-pretty-entities t
      org-link-file-path-type 'noabbrev

      )

;;; open link functions

(dolist (scheme '("ftp" "http" "https" "mailto" "news"))
  (org-link-set-parameters scheme
                           :follow
                           (lambda (url &optional arg)
			     (browse-url (concat scheme ":" url) arg))))

(use-package "tablist" 'tablist)
(setq pdf-info-epdfinfo-program "/Users/durand/elisp_packages/pdf-tools/epdfinfo" )
(load-config "org-pdftools.el")
(set 'org-pdftools-link-prefix "pdfview")
(org-pdftools-setup-link)

;;; Archive advice

;;;###autoload
(defun durand-archive-save-and-kill (old-fun &optional find-done)
  "Save and kill the buffer after archiving."
  (let* ((location (org-archive--compute-location
                    (or (org-entry-get nil "ARCHIVE" 'inherit)
                        org-archive-location)))
         (archive-buffer-name (file-name-nondirectory (car location)))
         (opened (get-buffer archive-buffer-name)))
    (funcall old-fun find-done)
    (unless opened
      (when (get-buffer archive-buffer-name)
        (with-current-buffer archive-buffer-name
          (ignore-errors (save-buffer 0)))
        (kill-buffer archive-buffer-name)))))

(advice-add 'org-archive-subtree :around 'durand-archive-save-and-kill)

;;; Archiving

;;;###autoload
(defun durand-org-archive-file-name (file-name)
  "Produce an archive file name.
The rule is as follows:
example.org
example.org_archive
example(1).org_archive
example(2).org_archive
etc."
  (cond
   ((not (or (string-match "org$" file-name)
             (string-match "org_archive$" file-name)))
    (user-error "Not an org file.")))
  (cond
   ((string-match "org$" file-name)
    (replace-match "org_archive" nil nil file-name))
   ((string-match "\\((\\([[:digit:]]+\\))\\).org_archive$" file-name)
    (replace-match
     (format "(%d)"
             (1+ (string-to-number
                  (match-string-no-properties 2 file-name))))
     nil nil file-name 1))
   (t
    (replace-regexp-in-string ".org_archive$" "(1).org_archive" file-name))))

;;;###autoload
(defun durand-org-goto-archive ()
  "Go to the archive file of the current org file, if any.
It will cycle through all archive files of the file.
The rule is as follows:
example.org
example.org_archive
example(1).org_archive
example(2).org_archive
etc."
  (interactive)
  (unless (derived-mode-p 'org-mode)
    (user-error "Not in an org file."))
  (let* ((current-name (buffer-file-name (current-buffer)))
         (base-name (cond
                     ((string-match "org_archive$" current-name)
                      (replace-match "org" nil nil current-name))
                     (t current-name)))
         (base-name (cond
                     ((string-match "\\(([[:digit:]])\\).org$" base-name)
                      (replace-match "" nil nil base-name 1))
                     (t base-name)))
         (next-name (durand-org-archive-file-name current-name))
         (next-name (cond
                     ((file-exists-p next-name) next-name)
                     (t base-name))))
    (find-file next-name)))

;; NOTE: Modified by Durand to use `completing-read-multiple' instead of
;; `completing-read'.
;;;###autoload
(defun durand-org-set-tags-command (&optional arg)
  "Set the tags for the current visible entry.

When called with `\\[universal-argument]' prefix argument ARG, \
realign all tags
in the current buffer.

When called with `\\[universal-argument] \\[universal-argument]' prefix argument, \
unconditionally do not
offer the fast tag selection interface.

If a region is active, set tags in the region according to the
setting of `org-loop-over-headlines-in-active-region'.

This function is for interactive use only;
in Lisp code use `org-set-tags' instead."
  (interactive "P")
  (let ((org-use-fast-tag-selection
         (unless (equal '(16) arg) org-use-fast-tag-selection)))
    (cond
     ((equal '(4) arg) (org-align-tags t))
     ((and (org-region-active-p) org-loop-over-headlines-in-active-region)
      (let (org-loop-over-headlines-in-active-region) ;  hint: infinite recursion.
        (org-map-entries
         #'org-set-tags-command
         nil
         (if (eq org-loop-over-headlines-in-active-region 'start-level)
             'region-start-level
           'region)
         (lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))))
     (t
      (save-excursion
        (org-back-to-heading)
        (let* ((all-tags (org-get-tags))
               (table (setq org-last-tags-completion-table
                            (org--tag-add-to-alist
                             (and org-complete-tags-always-offer-all-agenda-tags
                                  (org-global-tags-completion-table
                                   (org-agenda-files)))
                             (or org-current-tag-alist (org-get-buffer-tags)))))
               (current-tags
                (cl-remove-if (lambda (tag) (get-text-property 0 'inherited tag))
                              all-tags))
               (inherited-tags
                (cl-remove-if-not (lambda (tag) (get-text-property 0 'inherited tag))
                                  all-tags))
               (tags
                (replace-regexp-in-string
                 ;; Ignore all forbidden characters in tags.
                 "[^[:alnum:]_@#%]+" ":"
                 (if (or (eq t org-use-fast-tag-selection)
                         (and org-use-fast-tag-selection
                              (delq nil (mapcar #'cdr table))))
                     (org-fast-tag-selection
                      current-tags
                      inherited-tags
                      table
                      (and org-fast-tag-selection-include-todo org-todo-key-alist))
                   (let ((org-add-colon-after-tag-completion (< 1 (length table))))
                     ;; I change this part
                     (org-trim
                      (org-make-tag-string
                       (completing-read-multiple
                        "Tags: "
                        #'org-tags-completion-function
                        nil nil (replace-regexp-in-string
                                 ":" ","
                                 (org-make-tag-string current-tags))
                        'org-tags-history))))))))
          (org-set-tags tags)))))
    ;; `save-excursion' may not replace the point at the right
    ;; position.
    (when (and (save-excursion (skip-chars-backward "*") (bolp))
               (looking-at-p " "))
      (forward-char))))

(advice-add 'org-set-tags-command :override 'durand-org-set-tags-command)

;;; Accounts

;;;###autoload
(defvar durand-org-capture-account-which-list
  '("breakfast" "brunch" "brunverage" "lunch" "dinner" "beverage" "snack" "fruit")
  "The list of purposes of accounts in the capture-template for accounting.")

;;;###autoload
(defun durand-org-capture-account-template ()
  "Org capture template for account."
  (let* ((shop-and-items (durand-org-complete-capture-account))
         (which (completing-read
                 "For what? "
                 durand-org-capture-account-which-list))
         (cost (number-to-string
                (read-number "Cost: " 0)))
         (from (completing-read "From: " '("Cash" "etique")))
         (active-time (format-time-string
                       (cdr org-time-stamp-formats)))
         (inactive-time
          (let ((temp active-time))
            (while (string-match "<\\|>" temp)
              (setf temp
                    (replace-match
                     (cond
                      ((string= (match-string-no-properties 0 temp) "<") "[")
                      ((string= (match-string-no-properties 0 temp) ">") "]"))
                     nil nil temp)))
            temp)))
    (format "%s\n  :PROPERTIES:\n  :cost: %s\n  :FROM: %s\n  :RECORD_TIME: %s\n  :END: \n  %s%%?"
            which cost from inactive-time shop-and-items)))

(require 'org-protocol)

(setq org-capture-templates
      '(("d" "Record Diaries" entry
         (file+olp+datetree "~/org/diary.org")
         "* %?\n  :PROPERTIES:\n  :RECORD_TIME: %U\n  :END:\n\n"
         :jump-to-captured t)
        ("l" "Store links" entry
         (file "/Users/durand/org/math_article_links.org")
         "* TO-THINK %? %(org-insert-time-stamp (org-read-date nil t \"+0d\") nil t)\n%a\n" :kill-buffer t)
        ("L" "for storing webpages" entry
         #'org-determine-link-file
         "* PENDING %(org-filter-title) %(org-determine-tag)\n  :PROPERTIES:\n  :RECORD_TIME: %U\n  :END:\n\n  %(org-filtered-link)\n  %i\n  %?"
         :empty-lines 1
         :kill-buffer t
         :immediate-finish t)
        ("t" "TODO" entry
         (file "~/org/aujourdhui.org")
         "* TODO %? %^{Date to do:}t\n  :PROPERTIES:\n  :RECORD_TIME: %U\n  :END:\n\n"
         :kill-buffer t)
        ;; ("b" "Blog posts" entry
        ;;  (file+headline "~/org/notes.org" "Blog posts")
        ;;  "* %? %(org-insert-time-stamp (org-read-date nil t \"+0d\"))\n%i\n")
        ;; ("a" "Abstractions" entry
        ;;  (file+headline "~/org/wiki.org" "Abstractions")
        ;;  "* ABSTRACT %?\n  :PROPERTIES:\n  :RECORD_TIME: %U\n  :END:\n\n")
        ("A" "Agenda" entry
         (file+headline "~/org/agenda.org" "Agenda")
         "* TODO %?\n  :PROPERTIES:\n  :RECORD_TIME: %U\n  :DURATION: %^{Date: }t\n  :END:\n\n")
        ;; ("y" "YiFu" entry
        ;;  (file+headline "~/org/wiki.org" "Yi Fu Tips")
        ;;  "* MEMO %^{word}\n  :PROPERTIES:\n  :STORY: %\\2\n  :MEANING: %\\3\n  :END:\n** Yi Fu story\n   %^{story}\n** Meaning\n   %^{meaning}"
        ;;  :kill-buffer t
        ;;  :immediate-finish t)
        ("c" "Chansons" entry
         (file+headline "~/org/wiki.org" "Liste de Chansons")
         "* MEMO %^{title}\n  :PROPERTIES:\n  :RECORD_TIME: %U\n  :LINK: [[%^{link}][%^{description}]]\n  :END:\n  %?"
         :jump-to-captured t)
        ;; ("f" "français" entry
        ;;  (file+headline "~/org/français/français.org" "Liste de mots français")
        ;;  "* MEMO %^{mot} :drill:\n  :PROPERTIES:\n  :DRILL_CARD_TYPE: français\n  :RECORD_TIME: %U\n  :MEANING: %^{ce qu'il veut dire}\n  :END:\n\n  MEANING: %\\2\n%?"
        ;;  :jump-to-captured t)
        ("g" "GNUS" entry
         (file "~/org/notes.org")
         "* TO-THINK %:subject\n  :PROPERTIES:\n  :RECORD_TIME: %U\n  :END:\n  %:from\n  %:to\n  %a\n  %?"
         :empty-lines 1
         :kill-buffer t)))

(setq org-capture-templates-contexts
      '(("g" ((in-mode . "gnus-summary-mode")
              (in-mode . "gnus-article-mode")))))

(setq org-agenda-custom-commands
        '(("o" "Custom"
           ((agenda ""
                    (;; (org-super-agenda-groups
                     ;;  '((:name "Progress today"
                     ;;     :log t
                     ;;     :order -1)
                     ;;    (:name "Morning Tasks"
                     ;;     :log t
                     ;;     :tag "morning"
                     ;;     :order 1)
                     ;;    (:name "Afternoon Taks"
                     ;;     :log t
                     ;;     :tag "afternoon"
                     ;;     :order 2)
                     ;;    (:name "Night Taks"
                     ;;     :log t
                     ;;     :tag "night"
                     ;;     :order 3)
                     ;;    (:name "Deadlines" :deadline t)
                     ;;    (:name "Health"
                     ;;     :tag "santé"
                     ;;     :log t
                     ;;     :order 5)
                     ;;    (:name "MATH"
                     ;;     :tag "math"
                     ;;     :order -1)
                     ;;    (:name "Très Important"
                     ;;     :priority "A"
                     ;;     :order -1)
                     ;;    (:name "Scheduled"
                     ;;     :and (:scheduled t :not (:priority "A"))
                     ;;     :order 5
                     ;;     :log t)))
                     (org-agenda-span 'day)
                     (org-agenda-sorting-strategy '(priority-down time-up))))
            ;; NOTE: A reading plan
            (tags "a_voir+matin|a_voir+après_midi|a_voir+nuit"
                  ((org-agenda-files '("~/org/notes.org"
                                       "~/org/math_article_links.org"))
                   (org-agenda-overriding-header "À Lire")
                   ;; (org-super-agenda-groups
                   ;;  '((:name "Le Matin" :tag "matin")
                   ;;    (:name "L'après-midi" :tag "après_midi")
                   ;;    (:name "La Nuit" :tag "nuit")))
                   ))
            (todo "TO-THINK"
                  (;; (org-super-agenda-groups
                   ;;  '((:name "À Voir" :tag "a_voir")
                   ;;    (:name "Mathématiques" :tag "math")
                   ;;    (:name "TeX" :tag "tex")
                   ;;    (:name "Question" :tag "question")))
                   (org-agenda-overriding-header "TO-THINK"))))
           ((org-agenda-block-separator nil)))
          ;; ("n" "test"
          ;;  ((durand-agenda-command-test)))
          ;; ("m" "sections with time"
          ;;  ((durand-agenda-command-sections-time)))
          ))

;;; elisp in link confirmation

(setq org-link-elisp-confirm-function 'y-or-n-p)

;;; agenda window setup

(setq org-agenda-window-setup 'other-tab)
;; The following will be ignored since the above is 'other-tab.
(setq org-agenda-restore-windows-after-quit t)

;;; novel addresses
;;;###autoload
(defvar durand-novel-addresses-regexp '("uukanshu"
                                        "ptwxz"
                                        "piaotian"
                                        "101novel"
                                        "booktxt")
  "Regexp for matching a novel website.")

;;;###autoload
(defun org-determine-link-file ()
  "Go to the file to capture to based upon the URL"
  (let* ((link (plist-get org-store-link-plist :link))
         (file-name
          (cond
           ((string-match-p "https?://www.youtube.com" link)
            "youtube_links.org")
           ((or
             (string-match-p "https?://math.stackexchange.com" link)
             (string-match-p "https?://mathoverflow.net/" link))
            "math_article_links.org")
           ((let ((temp durand-novel-addresses-regexp)
                  result)
              (while (and (consp temp) (not result))
                (cond
                 ((string-match-p (car temp) link)
                  (setq result t)))
                (setq temp (cdr temp)))
              result)
            "notes.org")
           ((string-match-p "https?://stacks.math.columbia.edu/" link)
            "math_article_links.org")
           (t
            "notes.org"))))
    (find-file (expand-file-name file-name org-directory))
    (goto-char (point-max))))

;; filter title in the link
;;;###autoload
(defun org-filtered-link ()
  "Filter out some unnecessary parts in the link description"
  (save-match-data
    (let* ((link (plist-get org-store-link-plist :link))
           (title (plist-get org-store-link-plist :description))
           (filtered (cond ((string-match " - Mathematics Stack Exchange" title)
                            (replace-match "" nil nil title))
                           ((string-match " - YouTube" title)
                            (replace-match "" nil nil title))
                           ((string-match "\\(.*?\\)最新章节列表,\\1无弹窗_UU看书" title)
                            (replace-match "\\1" nil nil title))
                           (t
                            title))))
      (org-link-make-string link filtered))))

;; Determine tag based upon the URL
;;;###autoload
(defun org-determine-tag ()
  "Determine tag based upon the URL"
  (let ((link (plist-get org-store-link-plist :link)))
    (cond
     ((string-match-p "https?://www.youtube.com" link)
      ":youtube:")
     ((or
       (string-match-p "https?://math.stackexchange.com" link)
       (string-match-p "https?://mathoverflow.net/" link))
      ":stack:web_link:")
     ((let ((temp durand-novel-addresses-regexp)
            result)
        (while (and (consp temp) (not result))
          (cond
           ((string-match-p (car temp) link)
            (setq result t)))
          (setq temp (cdr temp)))
        result)
      ":roman:")
     ((string-match-p "https?://stacks.math.columbia.edu/" link)
      ":web_link:stack:")
     (t
      ":web_link:"))))

;;;###autoload
(defun org-update-novels (&optional desc)
  "Update the html link to a novel, or to a web_link.
If DESC is non-`nil', then it is the description of the new link."
  (interactive)
;;; HACK: Refocus the selected frame.
;;; I was doing this in the applescript. But for some reason it is messed up. So
;;; I let Emacs gain focus by itself now.
  (select-frame-set-input-focus (selected-frame))
  (let* ((tags (completing-read "tag: " '("roman-ARCHIVE"
                                          "web_link-ARCHIVE")
                                nil t))
         (roman-p (string-match "roman" tags))
         (files '("/Users/durand/org/notes.org" "/Users/durand/org/math_article_links.org"))
         (prompt (if roman-p
                     "Chois un roman à mettre à jour: "
                   "Chois un web lien à mettre à jour: "))
         cands)
    (setf cands
          (cl-loop for file in files
                   append (with-current-file file nil
                            (org-map-entries
                             (lambda ()
                               (let ((orig (durand-org-link-info t)))
                                 (list (car orig) (cdr orig) file)))
                             tags))))
    (unless roman-p (setf cands (nreverse cands)))
    (let* ((choix (completing-read prompt cands nil t))
           (item (cl-assoc choix cands :test #'string=))
           (lien (read-string "Le lien: " (current-kill 0 t))))
      (with-current-file (caddr item) nil
        (goto-char (cadr item))
        (org-update-link lien nil nil desc)))))

;;; filter out the title

;;;###autoload
(defun org-filter-title ()
  "Filter out some unnecessary parts of the link title"
  (let ((title (plist-get org-store-link-plist :description)))
    (cond
     ((string-match " - Mathematics Stack Exchange" title)
      (replace-match "" nil nil title))
     ((string-match " - YouTube" title)
      (replace-match "" nil nil title))
     ((string-match "\\(.*?\\)最新章节列表,\\1无弹窗_UU看书" title)
      (replace-match "\\1" nil nil title))
     (t
      title))))