;;; module-org.el

(define-minor-mode evil-org-mode
  "Evil-mode bindings for org-mode."
  :init-value nil
  :lighter    "!"
  :keymap     (make-sparse-keymap) ; defines evil-org-mode-map
  :group      'evil-org)

(defvar org-directory (concat narf-dropbox-dir "org/"))
(defvar org-directory-contacts (expand-file-name "work/contacts/" org-directory))
(defvar org-directory-projects (expand-file-name "work/projects/" org-directory))
(defvar org-directory-invoices (expand-file-name "work/invoices/" org-directory))

(add-hook! org-load 'narf|org-init)
(add-hook! org-mode 'evil-org-mode)
(add-hook! org-mode 'narf|enable-hard-wrap)

;; Fixes when saveplace places the point in a folded position
(defun narf|org-restore-point ()
  (when (outline-invisible-p)
    (ignore-errors
      (save-excursion
        (outline-previous-visible-heading 1)
        (org-show-subtree)))))
(add-hook! org-mode 'narf|org-restore-point)

;; Realign tables and tags on save
(defun narf|org-realign ()
  (org-align-all-tags))
(defun narf|org-update ()
  (org-update-statistics-cookies t))
(add-hook! org-mode
  (add-hook 'before-save-hook 'narf|org-realign nil t)
  (add-hook 'before-save-hook 'narf|org-update nil t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun narf@org-vars ()
  (setq org-default-notes-file (concat org-directory "notes.org")
        org-agenda-files
        (f-entries org-directory (lambda (path) (f-ext? path "org")) t)

        org-archive-location (concat org-directory "/archive/%s::")
        org-attach-directory ".attach/"

        ;; org-mobile-inbox-for-pull (concat org-directory "inbox.org")
        ;; org-mobile-directory "~/Dropbox/Apps/MobileOrg"

        org-catch-invisible-edits nil
        org-confirm-elisp-link-function nil
        org-completion-use-ido t
        org-hidden-keywords '(title)
        org-special-ctrl-a/e t
        org-hierarchical-todo-statistics t
        org-checkbox-hierarchical-statistics nil
        org-tags-column 0
        org-loop-over-headlines-in-active-region t
        org-footnote-auto-label 'plain
        org-log-done t
        org-agenda-window-setup 'current-window
        org-src-window-setup 'current-window
        org-startup-folded 'content
        org-todo-keywords '((sequence "TODO(t)" "|" "DONE(d)")
                            (sequence "LEAD(l)" "NEXT(n)" "ACTIVE(a)" "PENDING(p)" "|" "CANCELLED(c)"))
        org-blank-before-new-entry '((heading . nil)
                                     (plain-list-item . auto))
        org-export-backends '(ascii html latex md opml)

        org-tag-alist '(("@home" . ?h)
                        ("@daily" . ?d)
                        ("@projects" . ?r))

        org-capture-templates
        '(("t" "TODO" entry (file+headline "~/Dropbox/notes/gtd.org" "Inbox") "** TODO %? %u\n%i")
          ("T" "Project TODO" entry (file+headline (narf/project-org-filename) "Tasks") "** TODO %?\n%i" :prepend t)
          ("N" "Project Note" entry (file+headline (narf/project-org-filename) "Notes") "** %u %?\n%i")
          ("c" "Changelog" entry (file+datetree (narf/project-org-filename)) "** %<%H:%M>: %? :unsorted:\n%i" :prepend t)
          ("n" "Note" entry (file+datetree org-default-notes-file) "** %<%H:%M>: %?\n%i" :prepend t)
          ("j" "Journal" entry (file+datetree "~/Dropbox/notes/journal.org") "** %?%^g\nAdded: %U\n%i")
          ("a" "Trivia" entry (file "~/Dropbox/notes/trivia.org") "* %u %?\n%i" :prepend t)
          ("s" "Writing Scraps" entry (file "~/Dropbox/notes/writing.org") "* %u %?\n%i" :prepend t)
          ("v" "Vocab" entry (file (concat org-directory "notes/vocab.org")) "* %?\n%i" :prepend t)
          ("e" "Excerpt" entry (file (concat org-directory "notes/excerpts.org")) "* %u %?\n%i" :prepend t)))

  (add-to-list 'org-link-frame-setup '(file . find-file)))

(defun narf@org-ex ()
  (exmap! "src"      'org-edit-special)
  (exmap! "refile"   'org-refile)
  (exmap! "archive"  'org-archive-subtree)
  (exmap! "agenda"   'org-agenda)
  (exmap! "todo"     'org-show-todo-tree)
  (exmap! "link"     'org-link)
  (exmap! "wc"       'narf/org-word-count)
  (exmap! "at[tach]" 'narf:org-attach)
  (exmap! "export"   'narf:org-export)

  ;; TODO
  ;; (exmap! "newc[ontact]" 'narf:org-new-contact)
  ;; (exmap! "newp[roject]" 'narf:org-new-project)
  ;; (exmap! "newi[nvoice]" 'narf:org-new-invoice)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun narf@org-babel ()
  (setq org-confirm-babel-evaluate nil   ; you don't need my permission
        org-src-fontify-natively t       ; make code pretty
        org-src-preserve-indentation t
        org-src-tab-acts-natively t)

  (defun narf-refresh-babel-lob ()
    (async-start `(lambda ()
                    ,(async-inject-variables "\\`\\(org-directory\\|load-path$\\)")
                    (require 'org)
                    (require 'f)
                    (setq org-babel-library-of-babel nil)
                    (mapc (lambda (f) (org-babel-lob-ingest f))
                          (f-entries ,org-directory (lambda (path) (f-ext? path "org")) t))
                    org-babel-library-of-babel)
                 (lambda (lib)
                   ;; (persistent-soft-store 'org-babel-library lib "org")
                   (message "Library of babel updated!")
                   (setq org-babel-library-of-babel lib))))
  (setq org-babel-library-of-babel (narf-refresh-babel-lob))
  (add-hook! org-mode
    (add-hook 'after-save-hook (lambda () (shut-up! (org-babel-lob-ingest (buffer-file-name)))) t t))

  (require 'ob-http)
  (require 'ob-rust)
  (org-babel-do-load-languages
   'org-babel-load-languages
   '((python . t) (ruby . t) (sh . t) (js . t) (css . t)
     (plantuml . t) (emacs-lisp . t) (matlab . t) (R . t)
     (latex . t) (calc . t)
     (http . t) (rust . t)))

  (defadvice org-edit-src-code (around set-buffer-file-name activate compile)
    (let ((file-name (buffer-file-name))) ;; (1)
      ad-do-it                            ;; (2)
      (setq buffer-file-name file-name))) ;; (3)

  (add-to-list 'org-src-lang-modes '("rust" . rust))
  (add-to-list 'org-src-lang-modes '("puml" . puml))
  (add-to-list 'org-src-lang-modes '("plantuml" . puml)))

(defun narf@org-latex ()
  (setq-default
   org-latex-preview-ltxpng-directory (concat narf-temp-dir "ltxpng/")
   org-latex-create-formula-image-program 'dvipng
   org-startup-with-latex-preview t
   org-highlight-latex-and-related '(latex))

  (require 'company-math)
  (define-company-backend! org-mode
    (math-symbols-latex
     math-symbols-unicode
     latex-commands
     company-capf
     company-yasnippet
     company-dabbrev-code
     company-keywords))

  (plist-put org-format-latex-options :scale 1.1))

(defun narf@org-looks ()
  (setq org-image-actual-width nil
        org-startup-with-inline-images t
        org-startup-indented t
        org-pretty-entities t
        org-pretty-entities-include-sub-superscripts t
        org-use-sub-superscripts '{}
        org-fontify-whole-heading-line nil
        org-fontify-done-headline t
        org-fontify-quote-and-verse-blocks t
        org-ellipsis 'hs-face
        org-indent-indentation-per-level 3
        org-list-indent-offset 4
        org-cycle-separator-lines 1
        org-hide-emphasis-markers t
        org-hide-leading-stars t)

  (add-hook! org-mode (setq truncate-lines nil))

  (let ((ext-regexp (regexp-opt '("GIF" "JPG" "JPEG" "SVG" "TIF" "TIFF" "BMP" "XPM"
                                  "gif" "jpg" "jpeg" "svg" "tif" "tiff" "bmp" "xpm"))))
    (setq iimage-mode-image-regex-alist
          `((,(concat "\\(`?file://\\|\\[\\[\\|<\\|`\\)?\\([-+./_0-9a-zA-Z]+\\."
                      ext-regexp "\\)\\(\\]\\]\\|>\\|'\\)?") . 2)
            (,(concat "<\\(http://.+\\." ext-regexp "\\)>") . 1))))

  (add-hook! org-mode
    (setq line-spacing '0.2)
    (variable-pitch-mode 1)
    (text-scale-set 0.5)
    (setq tab-width 3 evil-shift-width 3))

  (require 'org-bullets)
  (setq org-bullets-bullet-list '("✸" "•" "◦" "•" "◦" "•" "◦"))
  (add-hook! org-mode 'org-bullets-mode)

  ;; Restore org-block-background face (removed in official org)
  (defface org-block-background '((t ()))
    "Face used for the source block background.")
  (defun narf--adjoin-to-list-or-symbol (element list-or-symbol)
    (let ((list (if (not (listp list-or-symbol))
                    (list list-or-symbol)
                  list-or-symbol)))
      (require 'cl-lib)
      (cl-adjoin element list)))
  (set-face-attribute 'org-block-background nil :inherit
                      (narf--adjoin-to-list-or-symbol
                       'fixed-pitch
                       (face-attribute 'org-block-background :inherit)))

  ;; Prettify symbols, blocks and TODOs
  (defface org-todo-high '((t ())) "Face for high-priority todo")
  (defface org-todo-vhigh '((t ())) "Face for very high-priority todo")
  (defface org-item-checkbox '((t ())) "Face for checkbox list lines")
  (defface org-item-checkbox-checked '((t ())) "Face for checked checkbox list lines")
  (defface org-whitespace '((t ())) "Face for spaces")
  (font-lock-add-keywords
   'org-mode `(("^ *\\(#\\+begin_src\\>\\)"
                (0 (narf/show-as ?#)))
               ("^ *\\(#\\+end_src\\>\\)"
                (0 (narf/show-as ?#)))
               ("\\(#\\+begin_quote\\>\\)"
                (0 (narf/show-as ?\")))
               ("\\(#\\+end_quote\\>\\)"
                (0 (narf/show-as ?\")))

               ;; TODO Optimize these
               ;; Hide TODO tags
               ("\\([-+] \\[X\\]\\|\\* DONE\\) \\([^$:\n\r]+\\)"
                (0 (narf/show-as ?☑)))
               ("\\([-+] \\[ \\]\\|\\* TODO\\) \\([^$:\n\r]+\\)"
                (0 (narf/show-as ?☐)))

               ("\\([-+] \\[ \\] \\([^$:\n\r]+\\)\\)"
                (1 'org-item-checkbox))
               ("\\([-+] \\[X\\] \\([^$:\n\r]+\\)\\)"
                (1 'org-item-checkbox-checked))

               ;; Color code TODOs with !'s to denote priority
               ("\\(\\* TODO ?!! \\([^$:\n\r]+\\)\\)"
                (1 'org-todo-vhigh))
               ("\\(\\* TODO ?! \\([^$:\n\r]+\\)\\)"
                (1 'org-todo-high))

               (,(concat
                  "\\(\\*\\) "
                  (regexp-opt '("LEAD" "NEXT" "ACTIVE" "PENDING" "CANCELLED") t)
                  " ")
                (1 (narf/show-as ?☐)))

               ("\\(\\([-+]\\)\\( \\)+[^$\n\r]+\\)"
                (2 'org-code)
                (3 'org-whitespace))
               ("^ +\\(\\*\\) "
                (1 (narf/show-as ?◦)))
               ("^ +"
                (0 'org-whitespace))
               )))

(defun narf@org-plantuml ()
  (setq org-plantuml-jar-path puml-plantuml-jar-path)
  (when (file-exists-p "~/.plantuml")
    (add-to-list 'org-babel-default-header-args:plantuml
                 '(:cmdline . "-config ~/.plantuml"))))

(defun narf@org-links ()
  (defun narf--org-id-to-file (id dir &optional pattern)
    (let* ((glob (f-glob (format (concat "%s" (or pattern "%s-*.org")) dir id)))
           (glob-len (length glob)))
      (when (zerop glob-len)
        (user-error "Could not find file with that ID"))
      (car glob)))

  (defun narf-org-link-contact (id)
    (org-open-file (narf--org-id-to-file id org-directory-contacts) t))
  (defun narf-org-link-project (id)
    (org-open-file (narf--org-id-to-file id org-directory-projects) t))
  (defun narf-org-link-invoice (id)
    (org-open-file (narf--org-id-to-file id org-directory-invoices "%s.org") t))

  (org-add-link-type "contact" 'narf-org-link-contact)
  (org-add-link-type "project" 'narf-org-link-project)
  (org-add-link-type "invoice" 'narf-org-link-invoice)

  (defun narf-org-complete (type)
    (let ((default-directory (symbol-value (intern (format "org-directory-%ss" type)))))
      (let* ((file (org-iread-file-name ">>> "))
             (match (s-match "^\\([0-9]+\\)[-.]" (f-filename file))))
        (unless match
          (user-error "Invalid file ID"))
        (format "%s:%s" type (cadr match)))))

  (defun org-contact-complete-link ()
    (narf-org-complete "contact"))
  (defun org-project-complete-link ()
    (narf-org-complete "project"))
  (defun org-invoice-complete-link ()
    (narf-org-complete "invoice")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun narf|org-init ()
  (after! org-indent (diminish 'org-indent-mode))

  (use-package org-download
    :config
    (setq-default org-download-image-dir ".attach/"
                  org-download-screenshot-method "screencapture -i %s"))

  (when IS-MAC
    ;; Reveal files in finder
    (defvar org-file-apps '(("\\.org$" . emacs)
                            (t . "open `dirname \"%s\"`"))))

  (after! autoinsert
    (add-template! (format "%s.\\.org$" org-directory-contacts) "__contact.org"  'org-mode)
    (add-template! (format "%s.\\.org$" org-directory-projects) "__projects.org" 'org-mode)
    (add-template! (format "%s.\\.yml$" org-directory-invoices) "__invoices.org" 'org-mode))

  (advice-add 'evil-force-normal-state :before 'org-remove-occur-highlights)

  (narf@org-vars)
  (narf@org-babel)
  (narf@org-latex)
  (narf@org-looks)
  (narf@org-links)
  (narf@org-plantuml)
  (add-hook! org-mode 'narf@org-ex)
  (add-hook! evil-insert-state-exit 'narf|org-update)

  (use-package deft
    :commands (deft narf/deft-journal narf/deft-contacts narf/deft-invoices narf/deft-projects)
    :config
    (setq deft-directory org-directory
          deft-recursive t
          deft-separator " :: ")

    (defun narf/deft-projects ()
      (interactive)
      (let ((deft-directory org-directory-projects))
        (deft)))

    (defun narf/deft-contacts ()
      (interactive)
      (let ((deft-directory org-directory-contacts))
        (deft))))

  (require 'org-agenda)
  (setq org-agenda-restore-windows-after-quit t
        org-agenda-custom-commands
        '(("x" agenda)
          ("y" agenda*)
          ("l" todo "LEAD")
          ("t" todo)
          ("c" tags "+class")))

  ;; Add element delimiter text-objects so we can use evil-surround to
  ;; manipulate them.
  (define-text-object! "$" "\\$" "\\$")
  (define-text-object! "*" "\\*" "\\*")
  (define-text-object! "/" "/" "/")
  (define-text-object! "_" "_" "_")
  (define-text-object! "=" "=" "=")
  (define-text-object! "~" "~" "~")

  ;; Keybinds
  (bind!
   (:map org-mode-map
     "RET" nil
     "C-j" nil
     "C-k" nil

     :i [remap narf/inflate-space-maybe] 'org-self-insert-command
     :i "RET" 'org-return-indent)

   (:map evil-org-mode-map
     :ni "A-l" 'org-metaright
     :ni "A-h" 'org-metaleft
     :ni "A-k" 'org-metaup
     :ni "A-j" 'org-metadown
     ;; Expand tables (or shiftmeta move)
     :ni "A-L" 'narf/org-table-append-row-or-shift-right
     :ni "A-H" 'narf/org-table-prepend-row-or-shift-left
     :ni "A-K" 'narf/org-table-prepend-field-or-shift-up
     :ni "A-J" 'narf/org-table-append-field-or-shift-down

     :i  "C-L" 'narf/org-table-next-field
     :i  "C-H" 'narf/org-table-previous-field
     :i  "C-K" 'narf/org-table-previous-row
     :i  "C-J" 'narf/org-table-next-row

     :i  "C-e" 'org-end-of-line
     :i  "C-a" 'org-beginning-of-line

     :nv "j"   'evil-next-visual-line
     :nv "k"   'evil-previous-visual-line

     :i  "M-a" (λ (evil-visual-state) (org-mark-element))
     :n  "M-a" 'org-mark-element
     :v  "M-a" 'mark-whole-buffer

     :i  "<M-return>"   'narf/org-insert-item-after
     :i  "<S-M-return>" 'narf/org-insert-item-before

     :i  "M-b" (λ (narf/org-surround "*")) ; bold
     :i  "M-u" (λ (narf/org-surround "_")) ; underline
     :i  "M-i" (λ (narf/org-surround "/")) ; italics
     :i  "M-`" (λ (narf/org-surround "+")) ; strikethrough

     :v  "M-b" "S*"
     :v  "M-u" "S_"
     :v  "M-i" "S/"
     :v  "M-`" "S+"

     :n  ",;" 'helm-org-in-buffer-headings
     :nv ",l" 'org-insert-link
     :nv ",L" 'narf/org-replace-link-by-link-description
     :n  ",=" 'org-align-all-tags
     :n  ",f" 'org-sparse-tree
     :n  ",?" 'org-tags-view
     :n  ",a" 'org-attach
     :n  ",A" 'org-agenda
     :n  ",D" 'org-time-stamp-inactive
     :n  ",i" 'narf/org-toggle-inline-images-at-point
     :n  ",t" 'org-todo
     :n  ",T" 'org-show-todo-tree
     :n  ",d" 'org-time-stamp
     :n  ",r" 'org-refile
     :n  ",s" 'org-schedule
     :n  ",SPC" 'narf/org-toggle-checkbox
     :n  ",<return>" 'org-archive-subtree

     :n "za" 'org-cycle
     :n "zA" 'org-shifttab
     :n "zm" 'hide-body
     :n "zr" 'show-all
     :n "zo" 'show-subtree
     :n "zO" 'show-all
     :n "zc" 'hide-subtree
     :n "zC" 'hide-all

     :m  "]]" (λ (call-interactively 'org-forward-heading-same-level) (org-beginning-of-line))
     :m  "[[" (λ (call-interactively 'org-backward-heading-same-level) (org-beginning-of-line))
     :m  "]l" 'org-next-link
     :m  "[l" 'org-previous-link

     :n  "RET" 'narf/org-execute-at-point

     :m  "gh"  'outline-up-heading
     :m  "gj"  (λ (hide-subtree) (call-interactively 'org-forward-heading-same-level)  (show-children))
     :m  "gk"  (λ (hide-subtree) (call-interactively 'org-backward-heading-same-level) (show-children))
     :m  "gl"  (λ (call-interactively 'outline-next-visible-heading) (show-children))

     :n  "go"  'org-open-at-point
     :n  "gO"  (λ (let ((org-link-frame-setup (append '((file . find-file-other-window)) org-link-frame-setup))
                        (org-file-apps '(("\\.org$" . emacs)
                                         (t . "qlmanage -p \"%s\""))))
                    (call-interactively 'org-open-at-point)))

     :n  "gQ" 'org-fill-paragraph
     :m  "$" 'org-end-of-line
     :m  "^" 'org-beginning-of-line
     :n  "<" 'org-metaleft
     :n  ">" 'org-metaright
     :v  "<" (λ (org-metaleft)  (evil-visual-restore))
     :v  ">" (λ (org-metaright) (evil-visual-restore))
     :n  "-" 'org-cycle-list-bullet
     :n  "<S-M-return>" 'narf/org-insert-item-before
     :n  "<M-return>"   'narf/org-insert-item-after
     :n  [tab] 'org-cycle)

   (:after org-agenda
     (:map org-agenda-mode-map
       :e "<escape>" 'org-agenda-Quit
       :e "C-j" 'org-agenda-next-item
       :e "C-k" 'org-agenda-previous-item
       :e "C-n" 'org-agenda-next-item
       :e "C-p" 'org-agenda-previous-item)))

  (progn ;; Org hacks
    ;; Redefining this function so it doesn't open that "links" help buffer
    (defun org-insert-link (&optional complete-file link-location default-description)
      (interactive "P")
      (let* ((wcf (current-window-configuration))
             (origbuf (current-buffer))
             (region (if (org-region-active-p) (buffer-substring (region-beginning) (region-end))))
             (remove (and region (list (region-beginning) (region-end))))
             (desc region)
             tmphist ; byte-compile incorrectly complains about this
             (link link-location)
             (abbrevs org-link-abbrev-alist-local)
             entry file all-prefixes auto-desc)
        (cond
         (link-location) ; specified by arg, just use it.
         ((org-in-regexp org-bracket-link-regexp 1)
          ;; We do have a link at point, and we are going to edit it.
          (setq remove (list (match-beginning 0) (match-end 0)))
          (setq desc (if (match-end 3) (org-match-string-no-properties 3)))
          (setq link (read-string "Link: "
                                  (org-link-unescape
                                   (org-match-string-no-properties 1)))))
         ((or (org-in-regexp org-angle-link-re)
              (org-in-regexp org-plain-link-re))
          ;; Convert to bracket link
          (setq remove (list (match-beginning 0) (match-end 0))
                link (read-string "Link: " (org-remove-angle-brackets (match-string 0)))))
         ((member complete-file '((4) (16)))
          ;; Completing read for file names.
          (setq link (org-file-complete-link complete-file)))
         (t (org-link-fontify-links-to-this-file)
            (setq tmphist (append (mapcar 'car org-stored-links) org-insert-link-history))
            (setq all-prefixes (append (mapcar 'car abbrevs)
                                       (mapcar 'car org-link-abbrev-alist)
                                       org-link-types))
            (unwind-protect
                (progn (setq link (org-completing-read
                                   "Link: " (append (mapcar (lambda (x) (concat x ":")) all-prefixes)
                                                    (mapcar 'car org-stored-links))
                                   nil nil nil 'tmphist (caar org-stored-links)))
                       (if (not (string-match "\\S-" link))
                           (user-error "No link selected"))
                       (mapc (lambda(l)
                               (when (equal link (cadr l)) (setq link (car l) auto-desc t)))
                             org-stored-links)
                       (if (or (member link all-prefixes)
                               (and (equal ":" (substring link -1))
                                    (member (substring link 0 -1) all-prefixes)
                                    (setq link (substring link 0 -1))))
                           (setq link (with-current-buffer origbuf
                                        (org-link-try-special-completion link)))))
              (set-window-configuration wcf))
            (setq entry (assoc link org-stored-links))
            (or entry (push link org-insert-link-history))
            (setq desc (or desc (nth 1 entry)))))
        (if (funcall (if (equal complete-file '(64)) 'not 'identity)
                     (not org-keep-stored-link-after-insertion))
            (setq org-stored-links (delq (assoc link org-stored-links)
                                         org-stored-links)))
        (if (and (string-match org-plain-link-re link)
                 (not (string-match org-ts-regexp link)))
            (setq link (org-remove-angle-brackets link)))
        (when (and buffer-file-name
                   (string-match "^file:\\(.+?\\)::\\(.+\\)" link))
          (let* ((path (match-string 1 link))
                 (case-fold-search nil)
                 (search (match-string 2 link)))
            (save-match-data
              (if (equal (file-truename buffer-file-name) (file-truename path))
                  (setq link search)))))
        (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link)
          (let* ((type (match-string 1 link))
                 (path (match-string 2 link))
                 (origpath path)
                 (case-fold-search nil))
            (cond ((or (eq org-link-file-path-type 'absolute)
                       (equal complete-file '(16)))
                   (setq path (abbreviate-file-name (expand-file-name path))))
                  ((eq org-link-file-path-type 'noabbrev)
                   (setq path (expand-file-name path)))
                  ((eq org-link-file-path-type 'relative)
                   (setq path (file-relative-name path)))
                  (t (save-match-data
                       (if (string-match (concat "^" (regexp-quote (expand-file-name
                                                                    (file-name-as-directory default-directory))))
                                         (expand-file-name path))
                           (setq path (substring (expand-file-name path) (match-end 0)))
                         (setq path (abbreviate-file-name (expand-file-name path)))))))
            (setq link (concat type path))
            (if (equal desc origpath)
                (setq desc path))))
        (if org-make-link-description-function
            (setq desc
                  (or (condition-case nil
                          (funcall org-make-link-description-function link desc)
                        (error (progn (message "Can't get link description from `%s'"
                                               (symbol-name org-make-link-description-function))
                                      (sit-for 2) nil)))
                      (read-string "Description: " default-description)))
          (if default-description (setq desc default-description)
            (setq desc (or (and auto-desc desc)
                           (read-string "Description: " desc)))))
        (unless (string-match "\\S-" desc) (setq desc nil))
        (if remove (apply 'delete-region remove))
        (insert (org-make-link-string link desc))))

    (defun org-fontify-meta-lines-and-blocks-1 (limit)
      "Fontify #+ lines and blocks."
      (let ((case-fold-search t))
        (if (re-search-forward
             "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
             limit t)
            (let ((beg (match-beginning 0))
                  (block-start (match-end 0))
                  (block-end nil)
                  (lang (match-string 7))
                  (beg1 (line-beginning-position 2))
                  (dc1 (downcase (match-string 2)))
                  (dc3 (downcase (match-string 3)))
                  end end1 quoting block-type ovl)
              (cond
               ((and (match-end 4) (equal dc3 "+begin"))
                ;; Truly a block
                (setq block-type (downcase (match-string 5))
                      quoting (member block-type org-protecting-blocks))
                (when (re-search-forward
                       (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
                       nil t)  ;; on purpose, we look further than LIMIT
                  (setq end (min (point-max) (match-end 0))
                        end1 (min (point-max) (1- (match-beginning 0))))
                  (setq block-end (match-beginning 0))
                  (when quoting
                    (org-remove-flyspell-overlays-in beg1 end1)
                    (remove-text-properties beg end
                                            '(display t invisible t intangible t)))
                  (add-text-properties
                   beg end '(font-lock-fontified t font-lock-multiline t))
                  (add-text-properties beg beg1 '(face org-meta-line))
                  (org-remove-flyspell-overlays-in beg beg1)
                  (add-text-properties	; For end_src
                   end1 (min (point-max) (1+ end)) '(face org-meta-line))
                  (org-remove-flyspell-overlays-in end1 end)
                  (cond
                   ((and lang (not (string= lang "")) org-src-fontify-natively)
                    (org-src-font-lock-fontify-block lang block-start block-end)
                    ;; remove old background overlays
                    (mapc (lambda (ov)
                            (if (eq (overlay-get ov 'face) 'org-block-background)
                                (delete-overlay ov)))
                          (overlays-at (/ (+ beg1 block-end) 2)))
                    ;; add a background overlay
                    (setq ovl (make-overlay beg1 block-end))
                    (overlay-put ovl 'face 'org-block-background)
                    (overlay-put ovl 'evaporate t)) ; make it go away when empty
                   ;; (add-text-properties beg1 block-end '(src-block t)))
                   (quoting
                    (add-text-properties beg1 (min (point-max) (1+ end1))
                                         '(face org-block))) ; end of source block
                   ((not org-fontify-quote-and-verse-blocks))
                   ((string= block-type "quote")
                    (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote)))
                   ((string= block-type "verse")
                    (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse))))
                  (add-text-properties beg beg1 '(face org-block-begin-line))
                  (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
                                       '(face org-block-end-line))
                  t))
               ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
                (org-remove-flyspell-overlays-in
                 (match-beginning 0)
                 (if (equal "+title:" dc1) (match-end 2) (match-end 0)))
                (add-text-properties
                 beg (match-end 3)
                 (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
                     '(font-lock-fontified t invisible t)
                   '(font-lock-fontified t face org-document-info-keyword)))
                (add-text-properties
                 (match-beginning 6) (min (point-max) (1+ (match-end 6)))
                 (if (string-equal dc1 "+title:")
                     '(font-lock-fontified t face org-document-title)
                   '(font-lock-fontified t face org-document-info))))
               ((equal dc1 "+caption:")
                (org-remove-flyspell-overlays-in (match-end 2) (match-end 0))
                (remove-text-properties (match-beginning 0) (match-end 0)
                                        '(display t invisible t intangible t))
                (add-text-properties (match-beginning 1) (match-end 3)
                                     '(font-lock-fontified t face org-meta-line))
                (add-text-properties (match-beginning 6) (+ (match-end 6) 1)
                                     '(font-lock-fontified t face org-block))
                t)
               ((member dc3 '(" " ""))
                (org-remove-flyspell-overlays-in beg (match-end 0))
                (add-text-properties
                 beg (match-end 0)
                 '(font-lock-fontified t face font-lock-comment-face)))
               (t ;; just any other in-buffer setting, but not indented
                (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
                (remove-text-properties (match-beginning 0) (match-end 0)
                                        '(display t invisible t intangible t))
                (add-text-properties beg (match-end 0)
                                     '(font-lock-fontified t face org-meta-line))
                t))))))
    ))

(provide 'module-org)
;;; module-org.el ends here