forked from mirrors/org-mode
Move compatibility functions in "org-compat.el"
* lisp/org.el (org-imenu-and-speedbar): (org-imenu-markers): (org-imenu-new-marker): (org-imenu-get-tree): (org-speedbar-restriction-lock-overlay): (org-speedbar-set-agenda-restriction): (org--flyspell-object-check-p): (org-mode-flyspell-verify): (org-remove-flyspell-overlays-in): (org-bookmark-jump-unhide): (org-mark-jump-unhide): Move... * lisp/org-compat.el: ... there.
This commit is contained in:
Nicolas Goaziou
parent
95b76608a6
commit
7554012cef
|
|
@ -32,20 +32,33 @@
|
|||
(require 'cl-lib)
|
||||
(require 'org-macs)
|
||||
|
||||
(declare-function org-agenda-maybe-redo "org-agenda" ())
|
||||
(declare-function org-at-heading-p "org" (&optional ignored))
|
||||
(declare-function org-at-table.el-p "org" (&optional table-type))
|
||||
(declare-function org-element-at-point "org-element" ())
|
||||
(declare-function org-element-context "org-element" (&optional element))
|
||||
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
|
||||
(declare-function org-element-type "org-element" (element))
|
||||
(declare-function org-element-property "org-element" (property element))
|
||||
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
|
||||
(declare-function org-invisible-p "org" (&optional pos))
|
||||
(declare-function org-link-display-format "org" (s))
|
||||
(declare-function org-link-set-parameters "org" (type &rest rest))
|
||||
(declare-function org-log-into-drawer "org" ())
|
||||
(declare-function org-reduced-level "org" (l))
|
||||
(declare-function org-show-context "org" (&optional key))
|
||||
(declare-function org-table-end (&optional table-type))
|
||||
(declare-function outline-next-heading "outline" ())
|
||||
(declare-function speedbar-line-directory "speedbar" (&optional depth))
|
||||
(declare-function table--at-cell-p "table" (position &optional object at-column))
|
||||
|
||||
(defvar org-complex-heading-regexp)
|
||||
(defvar org-table-any-border-regexp)
|
||||
(defvar org-table-dataline-regexp)
|
||||
(defvar org-table-tab-recognizes-table.el)
|
||||
(defvar org-table1-hline-regexp)
|
||||
|
||||
|
||||
;;; Emacs < 25.1 compatibility
|
||||
|
||||
(when (< emacs-major-version 25)
|
||||
|
|
@ -468,6 +481,7 @@ ignored in this case."
|
|||
'set-transient-map
|
||||
'set-temporary-overlay-map))
|
||||
|
||||
|
||||
;;; Region compatibility
|
||||
|
||||
(defvar org-ignore-region nil
|
||||
|
|
@ -484,6 +498,7 @@ Unlike to `use-region-p', this function also checks
|
|||
(> (point) (region-beginning)))
|
||||
(exchange-point-and-mark)))
|
||||
|
||||
|
||||
;;; Invisibility compatibility
|
||||
|
||||
(defun org-remove-from-invisibility-spec (arg)
|
||||
|
|
@ -574,7 +589,9 @@ effect, which variables to use depends on the Emacs version."
|
|||
`(org-unmodified ,@body)))
|
||||
(def-edebug-spec org-with-silent-modifications (body))
|
||||
|
||||
;; Functions for Emacs < 24.4 compatibility
|
||||
|
||||
;;; Functions for Emacs < 24.4 compatibility
|
||||
|
||||
(defun org-define-error (name message)
|
||||
"Define NAME as a new error signal.
|
||||
MESSAGE is a string that will be output to the echo area if such
|
||||
|
|
@ -595,6 +612,284 @@ attention to case differences."
|
|||
(eq t (compare-strings suffix nil nil
|
||||
string start-pos nil ignore-case))))))
|
||||
|
||||
|
||||
;;; Integration with and fixes for other packages
|
||||
|
||||
(defgroup org-imenu-and-speedbar nil
|
||||
"Options concerning imenu and speedbar in Org mode."
|
||||
:tag "Org Imenu and Speedbar"
|
||||
:group 'org-structure)
|
||||
|
||||
(defcustom org-imenu-depth 2
|
||||
"The maximum level for Imenu access to Org headlines.
|
||||
This also applied for speedbar access."
|
||||
:group 'org-imenu-and-speedbar
|
||||
:type 'integer)
|
||||
|
||||
;;;; Imenu
|
||||
|
||||
(defvar-local org-imenu-markers nil
|
||||
"All markers currently used by Imenu.")
|
||||
|
||||
(defun org-imenu-new-marker (&optional pos)
|
||||
"Return a new marker for use by Imenu, and remember the marker."
|
||||
(let ((m (make-marker)))
|
||||
(move-marker m (or pos (point)))
|
||||
(push m org-imenu-markers)
|
||||
m))
|
||||
|
||||
(defun org-imenu-get-tree ()
|
||||
"Produce the index for Imenu."
|
||||
(dolist (x org-imenu-markers) (move-marker x nil))
|
||||
(setq org-imenu-markers nil)
|
||||
(let* ((case-fold-search nil)
|
||||
(n org-imenu-depth)
|
||||
(re (concat "^" (org-get-limited-outline-regexp)))
|
||||
(subs (make-vector (1+ n) nil))
|
||||
(last-level 0)
|
||||
m level head0 head)
|
||||
(org-with-wide-buffer
|
||||
(goto-char (point-max))
|
||||
(while (re-search-backward re nil t)
|
||||
(setq level (org-reduced-level (funcall outline-level)))
|
||||
(when (and (<= level n)
|
||||
(looking-at org-complex-heading-regexp)
|
||||
(setq head0 (match-string-no-properties 4)))
|
||||
(setq head (org-link-display-format head0)
|
||||
m (org-imenu-new-marker))
|
||||
(org-add-props head nil 'org-imenu-marker m 'org-imenu t)
|
||||
(if (>= level last-level)
|
||||
(push (cons head m) (aref subs level))
|
||||
(push (cons head (aref subs (1+ level))) (aref subs level))
|
||||
(cl-loop for i from (1+ level) to n do (aset subs i nil)))
|
||||
(setq last-level level))))
|
||||
(aref subs 1)))
|
||||
|
||||
(eval-after-load "imenu"
|
||||
'(progn
|
||||
(add-hook 'imenu-after-jump-hook
|
||||
(lambda ()
|
||||
(when (derived-mode-p 'org-mode)
|
||||
(org-show-context 'org-goto))))))
|
||||
|
||||
;;;; Speedbar
|
||||
|
||||
(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
|
||||
"Overlay marking the agenda restriction line in speedbar.")
|
||||
(overlay-put org-speedbar-restriction-lock-overlay
|
||||
'face 'org-agenda-restriction-lock)
|
||||
(overlay-put org-speedbar-restriction-lock-overlay
|
||||
'help-echo "Agendas are currently limited to this item.")
|
||||
(delete-overlay org-speedbar-restriction-lock-overlay)
|
||||
|
||||
(defun org-speedbar-set-agenda-restriction ()
|
||||
"Restrict future agenda commands to the location at point in speedbar.
|
||||
To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
|
||||
(interactive)
|
||||
(require 'org-agenda)
|
||||
(let (p m tp np dir txt)
|
||||
(cond
|
||||
((setq p (text-property-any (point-at-bol) (point-at-eol)
|
||||
'org-imenu t))
|
||||
(setq m (get-text-property p 'org-imenu-marker))
|
||||
(with-current-buffer (marker-buffer m)
|
||||
(goto-char m)
|
||||
(org-agenda-set-restriction-lock 'subtree)))
|
||||
((setq p (text-property-any (point-at-bol) (point-at-eol)
|
||||
'speedbar-function 'speedbar-find-file))
|
||||
(setq tp (previous-single-property-change
|
||||
(1+ p) 'speedbar-function)
|
||||
np (next-single-property-change
|
||||
tp 'speedbar-function)
|
||||
dir (speedbar-line-directory)
|
||||
txt (buffer-substring-no-properties (or tp (point-min))
|
||||
(or np (point-max))))
|
||||
(with-current-buffer (find-file-noselect
|
||||
(let ((default-directory dir))
|
||||
(expand-file-name txt)))
|
||||
(unless (derived-mode-p 'org-mode)
|
||||
(user-error "Cannot restrict to non-Org mode file"))
|
||||
(org-agenda-set-restriction-lock 'file)))
|
||||
(t (user-error "Don't know how to restrict Org mode agenda")))
|
||||
(move-overlay org-speedbar-restriction-lock-overlay
|
||||
(point-at-bol) (point-at-eol))
|
||||
(setq current-prefix-arg nil)
|
||||
(org-agenda-maybe-redo)))
|
||||
|
||||
(defvar speedbar-file-key-map)
|
||||
(declare-function speedbar-add-supported-extension "speedbar" (extension))
|
||||
(eval-after-load "speedbar"
|
||||
'(progn
|
||||
(speedbar-add-supported-extension ".org")
|
||||
(define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
|
||||
(define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
|
||||
(define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
|
||||
(define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
|
||||
(add-hook 'speedbar-visiting-tag-hook
|
||||
(lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
|
||||
|
||||
;;;; Flyspell
|
||||
|
||||
(defun org--flyspell-object-check-p (element)
|
||||
"Non-nil when Flyspell can check object at point.
|
||||
ELEMENT is the element at point."
|
||||
(let ((object (save-excursion
|
||||
(when (looking-at-p "\\>") (backward-char))
|
||||
(org-element-context element))))
|
||||
(cl-case (org-element-type object)
|
||||
;; Prevent checks in links due to keybinding conflict with
|
||||
;; Flyspell.
|
||||
((code entity export-snippet inline-babel-call
|
||||
inline-src-block line-break latex-fragment link macro
|
||||
statistics-cookie target timestamp verbatim)
|
||||
nil)
|
||||
(footnote-reference
|
||||
;; Only in inline footnotes, within the definition.
|
||||
(and (eq (org-element-property :type object) 'inline)
|
||||
(< (save-excursion
|
||||
(goto-char (org-element-property :begin object))
|
||||
(search-forward ":" nil t 2))
|
||||
(point))))
|
||||
(otherwise t))))
|
||||
|
||||
(defun org-mode-flyspell-verify ()
|
||||
"Function used for `flyspell-generic-check-word-predicate'."
|
||||
(if (org-at-heading-p)
|
||||
;; At a headline or an inlinetask, check title only. This is
|
||||
;; faster than relying on `org-element-at-point'.
|
||||
(and (save-excursion (beginning-of-line)
|
||||
(and (let ((case-fold-search t))
|
||||
(not (looking-at-p "\\*+ END[ \t]*$")))
|
||||
(let ((case-fold-search nil))
|
||||
(looking-at org-complex-heading-regexp))))
|
||||
(match-beginning 4)
|
||||
(>= (point) (match-beginning 4))
|
||||
(or (not (match-beginning 5))
|
||||
(< (point) (match-beginning 5))))
|
||||
(let* ((element (org-element-at-point))
|
||||
(post-affiliated (org-element-property :post-affiliated element)))
|
||||
(cond
|
||||
;; Ignore checks in all affiliated keywords but captions.
|
||||
((< (point) post-affiliated)
|
||||
(and (save-excursion
|
||||
(beginning-of-line)
|
||||
(let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
|
||||
(> (point) (match-end 0))
|
||||
(org--flyspell-object-check-p element)))
|
||||
;; Ignore checks in LOGBOOK (or equivalent) drawer.
|
||||
((let ((log (org-log-into-drawer)))
|
||||
(and log
|
||||
(let ((drawer (org-element-lineage element '(drawer))))
|
||||
(and drawer
|
||||
(eq (compare-strings
|
||||
log nil nil
|
||||
(org-element-property :drawer-name drawer) nil nil t)
|
||||
t)))))
|
||||
nil)
|
||||
(t
|
||||
(cl-case (org-element-type element)
|
||||
((comment quote-section) t)
|
||||
(comment-block
|
||||
;; Allow checks between block markers, not on them.
|
||||
(and (> (line-beginning-position) post-affiliated)
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(skip-chars-forward " \r\t\n")
|
||||
(< (point) (org-element-property :end element)))))
|
||||
;; Arbitrary list of keywords where checks are meaningful.
|
||||
;; Make sure point is on the value part of the element.
|
||||
(keyword
|
||||
(and (member (org-element-property :key element)
|
||||
'("DESCRIPTION" "TITLE"))
|
||||
(save-excursion
|
||||
(search-backward ":" (line-beginning-position) t))))
|
||||
;; Check is globally allowed in paragraphs verse blocks and
|
||||
;; table rows (after affiliated keywords) but some objects
|
||||
;; must not be affected.
|
||||
((paragraph table-row verse-block)
|
||||
(let ((cbeg (org-element-property :contents-begin element))
|
||||
(cend (org-element-property :contents-end element)))
|
||||
(and cbeg (>= (point) cbeg) (< (point) cend)
|
||||
(org--flyspell-object-check-p element))))))))))
|
||||
(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
|
||||
|
||||
(defun org-remove-flyspell-overlays-in (beg end)
|
||||
"Remove flyspell overlays in region."
|
||||
(and (bound-and-true-p flyspell-mode)
|
||||
(fboundp 'flyspell-delete-region-overlays)
|
||||
(flyspell-delete-region-overlays beg end)))
|
||||
|
||||
(defvar flyspell-delayed-commands)
|
||||
(eval-after-load "flyspell"
|
||||
'(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
|
||||
|
||||
;;;; Bookmark
|
||||
|
||||
(defun org-bookmark-jump-unhide ()
|
||||
"Unhide the current position, to show the bookmark location."
|
||||
(and (derived-mode-p 'org-mode)
|
||||
(or (org-invisible-p)
|
||||
(save-excursion (goto-char (max (point-min) (1- (point))))
|
||||
(org-invisible-p)))
|
||||
(org-show-context 'bookmark-jump)))
|
||||
|
||||
;; Make `bookmark-jump' shows the jump location if it was hidden.
|
||||
(eval-after-load "bookmark"
|
||||
'(if (boundp 'bookmark-after-jump-hook)
|
||||
;; We can use the hook
|
||||
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
|
||||
;; Hook not available, use advice
|
||||
(defadvice bookmark-jump (after org-make-visible activate)
|
||||
"Make the position visible."
|
||||
(org-bookmark-jump-unhide))))
|
||||
|
||||
;;;; Saveplace
|
||||
|
||||
;; Make sure saveplace shows the location if it was hidden
|
||||
(eval-after-load "saveplace"
|
||||
'(defadvice save-place-find-file-hook (after org-make-visible activate)
|
||||
"Make the position visible."
|
||||
(org-bookmark-jump-unhide)))
|
||||
|
||||
;;;; Ecb
|
||||
|
||||
;; Make sure ecb shows the location if it was hidden
|
||||
(eval-after-load "ecb"
|
||||
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
|
||||
"Make hierarchy visible when jumping into location from ECB tree buffer."
|
||||
(when (derived-mode-p 'org-mode)
|
||||
(org-show-context))))
|
||||
|
||||
;;;; Simple
|
||||
|
||||
(defun org-mark-jump-unhide ()
|
||||
"Make the point visible with `org-show-context' after jumping to the mark."
|
||||
(when (and (derived-mode-p 'org-mode)
|
||||
(org-invisible-p))
|
||||
(org-show-context 'mark-goto)))
|
||||
|
||||
(eval-after-load "simple"
|
||||
'(defadvice pop-to-mark-command (after org-make-visible activate)
|
||||
"Make the point visible with `org-show-context'."
|
||||
(org-mark-jump-unhide)))
|
||||
|
||||
(eval-after-load "simple"
|
||||
'(defadvice exchange-point-and-mark (after org-make-visible activate)
|
||||
"Make the point visible with `org-show-context'."
|
||||
(org-mark-jump-unhide)))
|
||||
|
||||
(eval-after-load "simple"
|
||||
'(defadvice pop-global-mark (after org-make-visible activate)
|
||||
"Make the point visible with `org-show-context'."
|
||||
(org-mark-jump-unhide)))
|
||||
|
||||
;;;; Session
|
||||
|
||||
;; Make "session.el" ignore our circular variable.
|
||||
(defvar session-globals-exclude)
|
||||
(eval-after-load "session"
|
||||
'(add-to-list 'session-globals-exclude 'org-mark-ring))
|
||||
|
||||
(provide 'org-compat)
|
||||
|
||||
;;; org-compat.el ends here
|
||||
|
|
|
|||
313
lisp/org.el
313
lisp/org.el
|
|
@ -1713,17 +1713,6 @@ as possible."
|
|||
:group 'org-sparse-trees
|
||||
:type 'hook)
|
||||
|
||||
(defgroup org-imenu-and-speedbar nil
|
||||
"Options concerning imenu and speedbar in Org mode."
|
||||
:tag "Org Imenu and Speedbar"
|
||||
:group 'org-structure)
|
||||
|
||||
(defcustom org-imenu-depth 2
|
||||
"The maximum level for Imenu access to Org headlines.
|
||||
This also applied for speedbar access."
|
||||
:group 'org-imenu-and-speedbar
|
||||
:type 'integer)
|
||||
|
||||
(defgroup org-table nil
|
||||
"Options concerning tables in Org mode."
|
||||
:tag "Org Table"
|
||||
|
|
@ -4424,7 +4413,6 @@ This is needed for font-lock setup.")
|
|||
"org-agenda"
|
||||
(extra txt &optional level category tags dotime
|
||||
remove-re habitp))
|
||||
(declare-function org-agenda-maybe-redo "org-agenda" ())
|
||||
(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
|
||||
(declare-function org-agenda-save-markers-for-cut-and-paste
|
||||
"org-agenda"
|
||||
|
|
@ -4440,7 +4428,6 @@ This is needed for font-lock setup.")
|
|||
(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
|
||||
(declare-function orgtbl-send-table "org-table" (&optional maybe))
|
||||
(declare-function parse-time-string "parse-time" (string))
|
||||
(declare-function speedbar-line-directory "speedbar" (&optional depth))
|
||||
|
||||
(defvar align-mode-rules-list)
|
||||
(defvar calc-embedded-close-formula)
|
||||
|
|
@ -21647,6 +21634,28 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
|
|||
|
||||
;;; Generally useful functions
|
||||
|
||||
(defun org-link-display-format (s)
|
||||
"Replace links in string S with their description.
|
||||
If there is no description, use the link target."
|
||||
(save-match-data
|
||||
(replace-regexp-in-string
|
||||
org-bracket-link-analytic-regexp
|
||||
(lambda (m)
|
||||
(if (match-end 5) (match-string 5 m)
|
||||
(concat (match-string 1 m) (match-string 3 m))))
|
||||
s nil t)))
|
||||
|
||||
(defun org-toggle-link-display ()
|
||||
"Toggle the literal or descriptive display of links."
|
||||
(interactive)
|
||||
(if org-descriptive-links
|
||||
(progn (org-remove-from-invisibility-spec '(org-link))
|
||||
(org-restart-font-lock)
|
||||
(setq org-descriptive-links nil))
|
||||
(progn (add-to-invisibility-spec '(org-link))
|
||||
(org-restart-font-lock)
|
||||
(setq org-descriptive-links t))))
|
||||
|
||||
(defun org-get-at-eol (property n)
|
||||
"Get text property PROPERTY at the end of line less N characters."
|
||||
(get-text-property (- (point-at-eol) n) property))
|
||||
|
|
@ -24560,284 +24569,6 @@ when non-nil, is a regexp matching keywords names."
|
|||
(and extra (concat (and kwds "\\|") extra))
|
||||
"\\):[ \t]*\\(.*\\)"))
|
||||
|
||||
;;;; Integration with and fixes for other packages
|
||||
|
||||
;;; Imenu support
|
||||
|
||||
(defvar-local org-imenu-markers nil
|
||||
"All markers currently used by Imenu.")
|
||||
|
||||
(defun org-imenu-new-marker (&optional pos)
|
||||
"Return a new marker for use by Imenu, and remember the marker."
|
||||
(let ((m (make-marker)))
|
||||
(move-marker m (or pos (point)))
|
||||
(push m org-imenu-markers)
|
||||
m))
|
||||
|
||||
(defun org-imenu-get-tree ()
|
||||
"Produce the index for Imenu."
|
||||
(dolist (x org-imenu-markers) (move-marker x nil))
|
||||
(setq org-imenu-markers nil)
|
||||
(let* ((case-fold-search nil)
|
||||
(n org-imenu-depth)
|
||||
(re (concat "^" (org-get-limited-outline-regexp)))
|
||||
(subs (make-vector (1+ n) nil))
|
||||
(last-level 0)
|
||||
m level head0 head)
|
||||
(org-with-wide-buffer
|
||||
(goto-char (point-max))
|
||||
(while (re-search-backward re nil t)
|
||||
(setq level (org-reduced-level (funcall outline-level)))
|
||||
(when (and (<= level n)
|
||||
(looking-at org-complex-heading-regexp)
|
||||
(setq head0 (match-string-no-properties 4)))
|
||||
(setq head (org-link-display-format head0)
|
||||
m (org-imenu-new-marker))
|
||||
(org-add-props head nil 'org-imenu-marker m 'org-imenu t)
|
||||
(if (>= level last-level)
|
||||
(push (cons head m) (aref subs level))
|
||||
(push (cons head (aref subs (1+ level))) (aref subs level))
|
||||
(cl-loop for i from (1+ level) to n do (aset subs i nil)))
|
||||
(setq last-level level))))
|
||||
(aref subs 1)))
|
||||
|
||||
(eval-after-load "imenu"
|
||||
'(progn
|
||||
(add-hook 'imenu-after-jump-hook
|
||||
(lambda ()
|
||||
(when (derived-mode-p 'org-mode)
|
||||
(org-show-context 'org-goto))))))
|
||||
|
||||
(defun org-link-display-format (s)
|
||||
"Replace links in string S with their description.
|
||||
If there is no description, use the link target."
|
||||
(save-match-data
|
||||
(replace-regexp-in-string
|
||||
org-bracket-link-analytic-regexp
|
||||
(lambda (m)
|
||||
(if (match-end 5) (match-string 5 m)
|
||||
(concat (match-string 1 m) (match-string 3 m))))
|
||||
s nil t)))
|
||||
|
||||
(defun org-toggle-link-display ()
|
||||
"Toggle the literal or descriptive display of links."
|
||||
(interactive)
|
||||
(if org-descriptive-links
|
||||
(progn (org-remove-from-invisibility-spec '(org-link))
|
||||
(org-restart-font-lock)
|
||||
(setq org-descriptive-links nil))
|
||||
(progn (add-to-invisibility-spec '(org-link))
|
||||
(org-restart-font-lock)
|
||||
(setq org-descriptive-links t))))
|
||||
|
||||
;; Speedbar support
|
||||
|
||||
(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
|
||||
"Overlay marking the agenda restriction line in speedbar.")
|
||||
(overlay-put org-speedbar-restriction-lock-overlay
|
||||
'face 'org-agenda-restriction-lock)
|
||||
(overlay-put org-speedbar-restriction-lock-overlay
|
||||
'help-echo "Agendas are currently limited to this item.")
|
||||
(delete-overlay org-speedbar-restriction-lock-overlay)
|
||||
|
||||
(defun org-speedbar-set-agenda-restriction ()
|
||||
"Restrict future agenda commands to the location at point in speedbar.
|
||||
To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
|
||||
(interactive)
|
||||
(require 'org-agenda)
|
||||
(let (p m tp np dir txt)
|
||||
(cond
|
||||
((setq p (text-property-any (point-at-bol) (point-at-eol)
|
||||
'org-imenu t))
|
||||
(setq m (get-text-property p 'org-imenu-marker))
|
||||
(with-current-buffer (marker-buffer m)
|
||||
(goto-char m)
|
||||
(org-agenda-set-restriction-lock 'subtree)))
|
||||
((setq p (text-property-any (point-at-bol) (point-at-eol)
|
||||
'speedbar-function 'speedbar-find-file))
|
||||
(setq tp (previous-single-property-change
|
||||
(1+ p) 'speedbar-function)
|
||||
np (next-single-property-change
|
||||
tp 'speedbar-function)
|
||||
dir (speedbar-line-directory)
|
||||
txt (buffer-substring-no-properties (or tp (point-min))
|
||||
(or np (point-max))))
|
||||
(with-current-buffer (find-file-noselect
|
||||
(let ((default-directory dir))
|
||||
(expand-file-name txt)))
|
||||
(unless (derived-mode-p 'org-mode)
|
||||
(user-error "Cannot restrict to non-Org mode file"))
|
||||
(org-agenda-set-restriction-lock 'file)))
|
||||
(t (user-error "Don't know how to restrict Org mode agenda")))
|
||||
(move-overlay org-speedbar-restriction-lock-overlay
|
||||
(point-at-bol) (point-at-eol))
|
||||
(setq current-prefix-arg nil)
|
||||
(org-agenda-maybe-redo)))
|
||||
|
||||
(defvar speedbar-file-key-map)
|
||||
(declare-function speedbar-add-supported-extension "speedbar" (extension))
|
||||
(eval-after-load "speedbar"
|
||||
'(progn
|
||||
(speedbar-add-supported-extension ".org")
|
||||
(define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
|
||||
(define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
|
||||
(define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
|
||||
(define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
|
||||
(add-hook 'speedbar-visiting-tag-hook
|
||||
(lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
|
||||
|
||||
;;; Fixes and Hacks for problems with other packages
|
||||
|
||||
(defun org--flyspell-object-check-p (element)
|
||||
"Non-nil when Flyspell can check object at point.
|
||||
ELEMENT is the element at point."
|
||||
(let ((object (save-excursion
|
||||
(when (looking-at-p "\\>") (backward-char))
|
||||
(org-element-context element))))
|
||||
(cl-case (org-element-type object)
|
||||
;; Prevent checks in links due to keybinding conflict with
|
||||
;; Flyspell.
|
||||
((code entity export-snippet inline-babel-call
|
||||
inline-src-block line-break latex-fragment link macro
|
||||
statistics-cookie target timestamp verbatim)
|
||||
nil)
|
||||
(footnote-reference
|
||||
;; Only in inline footnotes, within the definition.
|
||||
(and (eq (org-element-property :type object) 'inline)
|
||||
(< (save-excursion
|
||||
(goto-char (org-element-property :begin object))
|
||||
(search-forward ":" nil t 2))
|
||||
(point))))
|
||||
(otherwise t))))
|
||||
|
||||
(defun org-mode-flyspell-verify ()
|
||||
"Function used for `flyspell-generic-check-word-predicate'."
|
||||
(if (org-at-heading-p)
|
||||
;; At a headline or an inlinetask, check title only. This is
|
||||
;; faster than relying on `org-element-at-point'.
|
||||
(and (save-excursion (beginning-of-line)
|
||||
(and (let ((case-fold-search t))
|
||||
(not (looking-at-p "\\*+ END[ \t]*$")))
|
||||
(let ((case-fold-search nil))
|
||||
(looking-at org-complex-heading-regexp))))
|
||||
(match-beginning 4)
|
||||
(>= (point) (match-beginning 4))
|
||||
(or (not (match-beginning 5))
|
||||
(< (point) (match-beginning 5))))
|
||||
(let* ((element (org-element-at-point))
|
||||
(post-affiliated (org-element-property :post-affiliated element)))
|
||||
(cond
|
||||
;; Ignore checks in all affiliated keywords but captions.
|
||||
((< (point) post-affiliated)
|
||||
(and (save-excursion
|
||||
(beginning-of-line)
|
||||
(let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
|
||||
(> (point) (match-end 0))
|
||||
(org--flyspell-object-check-p element)))
|
||||
;; Ignore checks in LOGBOOK (or equivalent) drawer.
|
||||
((let ((log (org-log-into-drawer)))
|
||||
(and log
|
||||
(let ((drawer (org-element-lineage element '(drawer))))
|
||||
(and drawer
|
||||
(eq (compare-strings
|
||||
log nil nil
|
||||
(org-element-property :drawer-name drawer) nil nil t)
|
||||
t)))))
|
||||
nil)
|
||||
(t
|
||||
(cl-case (org-element-type element)
|
||||
((comment quote-section) t)
|
||||
(comment-block
|
||||
;; Allow checks between block markers, not on them.
|
||||
(and (> (line-beginning-position) post-affiliated)
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(skip-chars-forward " \r\t\n")
|
||||
(< (point) (org-element-property :end element)))))
|
||||
;; Arbitrary list of keywords where checks are meaningful.
|
||||
;; Make sure point is on the value part of the element.
|
||||
(keyword
|
||||
(and (member (org-element-property :key element)
|
||||
'("DESCRIPTION" "TITLE"))
|
||||
(save-excursion
|
||||
(search-backward ":" (line-beginning-position) t))))
|
||||
;; Check is globally allowed in paragraphs verse blocks and
|
||||
;; table rows (after affiliated keywords) but some objects
|
||||
;; must not be affected.
|
||||
((paragraph table-row verse-block)
|
||||
(let ((cbeg (org-element-property :contents-begin element))
|
||||
(cend (org-element-property :contents-end element)))
|
||||
(and cbeg (>= (point) cbeg) (< (point) cend)
|
||||
(org--flyspell-object-check-p element))))))))))
|
||||
(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
|
||||
|
||||
(defun org-remove-flyspell-overlays-in (beg end)
|
||||
"Remove flyspell overlays in region."
|
||||
(and (bound-and-true-p flyspell-mode)
|
||||
(fboundp 'flyspell-delete-region-overlays)
|
||||
(flyspell-delete-region-overlays beg end)))
|
||||
|
||||
(defvar flyspell-delayed-commands)
|
||||
(eval-after-load "flyspell"
|
||||
'(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
|
||||
|
||||
;; Make `bookmark-jump' shows the jump location if it was hidden.
|
||||
(eval-after-load "bookmark"
|
||||
'(if (boundp 'bookmark-after-jump-hook)
|
||||
;; We can use the hook
|
||||
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
|
||||
;; Hook not available, use advice
|
||||
(defadvice bookmark-jump (after org-make-visible activate)
|
||||
"Make the position visible."
|
||||
(org-bookmark-jump-unhide))))
|
||||
|
||||
;; Make sure saveplace shows the location if it was hidden
|
||||
(eval-after-load "saveplace"
|
||||
'(defadvice save-place-find-file-hook (after org-make-visible activate)
|
||||
"Make the position visible."
|
||||
(org-bookmark-jump-unhide)))
|
||||
|
||||
;; Make sure ecb shows the location if it was hidden
|
||||
(eval-after-load "ecb"
|
||||
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
|
||||
"Make hierarchy visible when jumping into location from ECB tree buffer."
|
||||
(when (derived-mode-p 'org-mode)
|
||||
(org-show-context))))
|
||||
|
||||
(defun org-bookmark-jump-unhide ()
|
||||
"Unhide the current position, to show the bookmark location."
|
||||
(and (derived-mode-p 'org-mode)
|
||||
(or (org-invisible-p)
|
||||
(save-excursion (goto-char (max (point-min) (1- (point))))
|
||||
(org-invisible-p)))
|
||||
(org-show-context 'bookmark-jump)))
|
||||
|
||||
(defun org-mark-jump-unhide ()
|
||||
"Make the point visible with `org-show-context' after jumping to the mark."
|
||||
(when (and (derived-mode-p 'org-mode)
|
||||
(org-invisible-p))
|
||||
(org-show-context 'mark-goto)))
|
||||
|
||||
(eval-after-load "simple"
|
||||
'(defadvice pop-to-mark-command (after org-make-visible activate)
|
||||
"Make the point visible with `org-show-context'."
|
||||
(org-mark-jump-unhide)))
|
||||
|
||||
(eval-after-load "simple"
|
||||
'(defadvice exchange-point-and-mark (after org-make-visible activate)
|
||||
"Make the point visible with `org-show-context'."
|
||||
(org-mark-jump-unhide)))
|
||||
|
||||
(eval-after-load "simple"
|
||||
'(defadvice pop-global-mark (after org-make-visible activate)
|
||||
"Make the point visible with `org-show-context'."
|
||||
(org-mark-jump-unhide)))
|
||||
|
||||
;; Make session.el ignore our circular variable
|
||||
(defvar session-globals-exclude)
|
||||
(eval-after-load "session"
|
||||
'(add-to-list 'session-globals-exclude 'org-mark-ring))
|
||||
|
||||
;;;; Finish up
|
||||
|
||||
(provide 'org)
|
||||
|
|
|
|||
Loading…
Reference in New Issue