org-compat.el 48 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256
  1. ;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2004-2022 Free Software Foundation, Inc.
  3. ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
  4. ;; Keywords: outlines, hypermedia, calendar, wp
  5. ;; Homepage: https://orgmode.org
  6. ;;
  7. ;; This file is part of GNU Emacs.
  8. ;;
  9. ;; GNU Emacs is free software: you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation, either version 3 of the License, or
  12. ;; (at your option) any later version.
  13. ;; GNU Emacs is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;; GNU General Public License for more details.
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. ;;
  21. ;;; Commentary:
  22. ;; This file contains code needed for compatibility with older
  23. ;; versions of GNU Emacs and integration with other packages.
  24. ;;; Code:
  25. (require 'cl-lib)
  26. (require 'seq)
  27. (require 'org-macs)
  28. (declare-function org-agenda-diary-entry "org-agenda")
  29. (declare-function org-agenda-maybe-redo "org-agenda" ())
  30. (declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
  31. (declare-function org-agenda-remove-restriction-lock "org-agenda" (&optional noupdate))
  32. (declare-function org-calendar-goto-agenda "org-agenda" ())
  33. (declare-function org-align-tags "org" (&optional all))
  34. (declare-function org-at-heading-p "org" (&optional ignored))
  35. (declare-function org-at-table.el-p "org" ())
  36. (declare-function org-element-at-point "org-element" (&optional pom cached-only))
  37. (declare-function org-element-at-point-no-context "org-element" (&optional pom))
  38. (declare-function org-element-context "org-element" (&optional element))
  39. (declare-function org-element-lineage "org-element" (blob &optional types with-self))
  40. (declare-function org-element-type "org-element" (element))
  41. (declare-function org-element-property "org-element" (property element))
  42. (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
  43. (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
  44. (declare-function org-get-tags "org" (&optional pos local))
  45. (declare-function org-fold-hide-block-toggle "org-fold" (&optional force no-error element))
  46. (declare-function org-link-display-format "ol" (s))
  47. (declare-function org-link-set-parameters "ol" (type &rest rest))
  48. (declare-function org-log-into-drawer "org" ())
  49. (declare-function org-make-tag-string "org" (tags))
  50. (declare-function org-reduced-level "org" (l))
  51. (declare-function org-return "org" (&optional indent arg interactive))
  52. (declare-function org-fold-show-context "org-fold" (&optional key))
  53. (declare-function org-table-end "org-table" (&optional table-type))
  54. (declare-function outline-next-heading "outline" ())
  55. (declare-function speedbar-line-directory "speedbar" (&optional depth))
  56. (declare-function table--at-cell-p "table" (position &optional object at-column))
  57. (declare-function org-fold-region "org-fold" (from to flag &optional spec))
  58. (declare-function org-fold-show-all "org-fold" (&optional types))
  59. (defvar calendar-mode-map)
  60. (defvar org-complex-heading-regexp)
  61. (defvar org-agenda-diary-file)
  62. (defvar org-agenda-overriding-restriction)
  63. (defvar org-agenda-restriction-lock-overlay)
  64. (defvar org-table-any-border-regexp)
  65. (defvar org-table-dataline-regexp)
  66. (defvar org-table-tab-recognizes-table.el)
  67. (defvar org-table1-hline-regexp)
  68. (defvar org-fold-core-style)
  69. ;;; Emacs < 29 compatibility
  70. (defvar org-file-has-changed-p--hash-table (make-hash-table :test #'equal)
  71. "Internal variable used by `org-file-has-changed-p'.")
  72. (if (fboundp 'file-has-changed-p)
  73. (defalias 'org-file-has-changed-p #'file-has-changed-p)
  74. (defun org-file-has-changed-p (file &optional tag)
  75. "Return non-nil if FILE has changed.
  76. The size and modification time of FILE are compared to the size
  77. and modification time of the same FILE during a previous
  78. invocation of `org-file-has-changed-p'. Thus, the first invocation
  79. of `org-file-has-changed-p' always returns non-nil when FILE exists.
  80. The optional argument TAG, which must be a symbol, can be used to
  81. limit the comparison to invocations with identical tags; it can be
  82. the symbol of the calling function, for example."
  83. (let* ((file (directory-file-name (expand-file-name file)))
  84. (remote-file-name-inhibit-cache t)
  85. (fileattr (file-attributes file 'integer))
  86. (attr (and fileattr
  87. (cons (file-attribute-size fileattr)
  88. (file-attribute-modification-time fileattr))))
  89. (sym (concat (symbol-name tag) "@" file))
  90. (cachedattr (gethash sym org-file-has-changed-p--hash-table)))
  91. (when (not (equal attr cachedattr))
  92. (puthash sym attr org-file-has-changed-p--hash-table)))))
  93. ;;; Emacs < 28.1 compatibility
  94. (if (fboundp 'file-name-concat)
  95. (defalias 'org-file-name-concat #'file-name-concat)
  96. (defun org-file-name-concat (directory &rest components)
  97. "Append COMPONENTS to DIRECTORY and return the resulting string.
  98. Elements in COMPONENTS must be a string or nil.
  99. DIRECTORY or the non-final elements in COMPONENTS may or may not end
  100. with a slash -- if they don't end with a slash, a slash will be
  101. inserted before contatenating."
  102. (save-match-data
  103. (mapconcat
  104. #'identity
  105. (delq nil
  106. (mapcar
  107. (lambda (str)
  108. (when (and str (not (seq-empty-p str))
  109. (string-match "\\(.+\\)/?" str))
  110. (match-string 1 str)))
  111. (cons directory components)))
  112. "/"))))
  113. (if (fboundp 'directory-empty-p)
  114. (defalias 'org-directory-empty-p #'directory-empty-p)
  115. (defun org-directory-empty-p (dir)
  116. "Return t if DIR names an existing directory containing no other files."
  117. (and (file-directory-p dir)
  118. (null (directory-files dir nil directory-files-no-dot-files-regexp t)))))
  119. ;;; Emacs < 27.1 compatibility
  120. (unless (fboundp 'combine-change-calls)
  121. ;; A stub when `combine-change-calls' was not yet there.
  122. (defmacro combine-change-calls (_beg _end &rest body)
  123. (declare (debug (form form def-body)) (indent 2))
  124. `(progn ,@body)))
  125. (if (version< emacs-version "27.1")
  126. (defsubst org-replace-buffer-contents (source &optional _max-secs _max-costs)
  127. (replace-buffer-contents source))
  128. (defalias 'org-replace-buffer-contents #'replace-buffer-contents))
  129. (unless (fboundp 'proper-list-p)
  130. ;; `proper-list-p' was added in Emacs 27.1. The function below is
  131. ;; taken from Emacs subr.el 200195e824b^.
  132. (defun proper-list-p (object)
  133. "Return OBJECT's length if it is a proper list, nil otherwise.
  134. A proper list is neither circular nor dotted (i.e., its last cdr
  135. is nil)."
  136. (and (listp object) (ignore-errors (length object)))))
  137. (if (fboundp 'xor)
  138. ;; `xor' was added in Emacs 27.1.
  139. (defalias 'org-xor #'xor)
  140. (defsubst org-xor (a b)
  141. "Exclusive `or'."
  142. (if a (not b) b)))
  143. (unless (fboundp 'pcomplete-uniquify-list)
  144. ;; The misspelled variant was made obsolete in Emacs 27.1
  145. (defalias 'pcomplete-uniquify-list 'pcomplete-uniqify-list))
  146. (if (fboundp 'time-convert)
  147. (progn
  148. (defsubst org-time-convert-to-integer (time)
  149. (time-convert time 'integer))
  150. (defsubst org-time-convert-to-list (time)
  151. (time-convert time 'list)))
  152. (defun org-time-convert-to-integer (time)
  153. (floor (float-time time)))
  154. (defun org-time-convert-to-list (time)
  155. (seconds-to-time (float-time time))))
  156. ;; `newline-and-indent' did not take a numeric argument before 27.1.
  157. (if (version< emacs-version "27")
  158. (defsubst org-newline-and-indent (&optional _arg)
  159. (newline-and-indent))
  160. (defalias 'org-newline-and-indent #'newline-and-indent))
  161. (defun org--set-faces-extend (faces extend-p)
  162. "Set the :extend attribute of FACES to EXTEND-P.
  163. This is a no-op for Emacs versions lower than 27, since face
  164. extension beyond end of line was not controllable."
  165. (when (fboundp 'set-face-extend)
  166. (mapc (lambda (f) (set-face-extend f extend-p)) faces)))
  167. (if (fboundp 'string-distance)
  168. (defalias 'org-string-distance 'string-distance)
  169. (defun org-string-distance (s1 s2)
  170. "Return the edit (levenshtein) distance between strings S1 S2."
  171. (let* ((l1 (length s1))
  172. (l2 (length s2))
  173. (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil))
  174. (number-sequence 1 (1+ l1)))))
  175. (in (lambda (i j) (aref (aref dist i) j))))
  176. (setf (aref (aref dist 0) 0) 0)
  177. (dolist (j (number-sequence 1 l2))
  178. (setf (aref (aref dist 0) j) j))
  179. (dolist (i (number-sequence 1 l1))
  180. (setf (aref (aref dist i) 0) i)
  181. (dolist (j (number-sequence 1 l2))
  182. (setf (aref (aref dist i) j)
  183. (min
  184. (1+ (funcall in (1- i) j))
  185. (1+ (funcall in i (1- j)))
  186. (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
  187. (funcall in (1- i) (1- j)))))))
  188. (funcall in l1 l2))))
  189. (define-obsolete-function-alias 'org-babel-edit-distance 'org-string-distance
  190. "9.5")
  191. ;;; Emacs < 26.1 compatibility
  192. (if (fboundp 'line-number-display-width)
  193. (defalias 'org-line-number-display-width 'line-number-display-width)
  194. (defun org-line-number-display-width (&rest _) 0))
  195. (if (fboundp 'buffer-hash)
  196. (defalias 'org-buffer-hash 'buffer-hash)
  197. (defun org-buffer-hash () (md5 (current-buffer))))
  198. (unless (fboundp 'file-attribute-modification-time)
  199. (defsubst file-attribute-modification-time (attributes)
  200. "The modification time in ATTRIBUTES returned by `file-attributes'.
  201. This is the time of the last change to the file's contents, and
  202. is a list of integers (HIGH LOW USEC PSEC) in the same style
  203. as (current-time)."
  204. (nth 5 attributes)))
  205. (unless (fboundp 'file-attribute-size)
  206. (defsubst file-attribute-size (attributes)
  207. "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
  208. This is a floating point number if the size is too large for an integer."
  209. (nth 7 attributes)))
  210. ;;; Obsolete aliases (remove them after the next major release).
  211. ;;;; XEmacs compatibility, now removed.
  212. (define-obsolete-function-alias 'org-activate-mark 'activate-mark "9.0")
  213. (define-obsolete-function-alias 'org-add-hook 'add-hook "9.0")
  214. (define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "9.0")
  215. (define-obsolete-function-alias 'org-decompose-region 'decompose-region "9.0")
  216. (define-obsolete-function-alias 'org-defvaralias 'defvaralias "9.0")
  217. (define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "9.0")
  218. (define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "9.0")
  219. (define-obsolete-function-alias 'org-float-time 'float-time "9.0")
  220. (define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "9.0")
  221. (define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "9.0")
  222. (define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "9.0")
  223. (define-obsolete-function-alias 'org-looking-back 'looking-back "9.0")
  224. (define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "9.0")
  225. (define-obsolete-function-alias 'org-propertize 'propertize "9.0")
  226. (define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "9.0")
  227. (define-obsolete-function-alias 'org-file-remote-p 'file-remote-p "9.2")
  228. (defmacro org-re (s)
  229. "Replace posix classes in regular expression S."
  230. (declare (debug (form))
  231. (obsolete "you can safely remove it." "9.0"))
  232. s)
  233. ;;;; Functions from cl-lib that Org used to have its own implementation of.
  234. (define-obsolete-function-alias 'org-count 'cl-count "9.0")
  235. (define-obsolete-function-alias 'org-every 'cl-every "9.0")
  236. (define-obsolete-function-alias 'org-find-if 'cl-find-if "9.0")
  237. (define-obsolete-function-alias 'org-reduce 'cl-reduce "9.0")
  238. (define-obsolete-function-alias 'org-remove-if 'cl-remove-if "9.0")
  239. (define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "9.0")
  240. (define-obsolete-function-alias 'org-some 'cl-some "9.0")
  241. (define-obsolete-function-alias 'org-floor* 'cl-floor "9.0")
  242. (defun org-sublist (list start end)
  243. "Return a section of LIST, from START to END.
  244. Counting starts at 1."
  245. (cl-subseq list (1- start) end))
  246. (make-obsolete 'org-sublist
  247. "use cl-subseq (note the 0-based counting)."
  248. "9.0")
  249. ;;;; Functions available since Emacs 25.1
  250. (define-obsolete-function-alias 'org-string-collate-lessp 'string-collate-lessp "9.6")
  251. (define-obsolete-function-alias 'org-decode-time 'decode-time "9.6")
  252. (define-obsolete-function-alias 'org-format-time-string 'format-time-string "9.6")
  253. (define-obsolete-function-alias 'org-time-add 'time-add "9.6")
  254. (define-obsolete-function-alias 'org-time-subtract 'time-subtract "9.6")
  255. (define-obsolete-function-alias 'org-time-since 'time-since "9.6")
  256. (define-obsolete-function-alias 'org-time-less-p 'time-less-p "9.6")
  257. ;;;; Functions available since Emacs 24.3
  258. (define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "9.0")
  259. (define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "9.0")
  260. (define-obsolete-function-alias 'org-char-to-string 'char-to-string "9.0")
  261. (define-obsolete-function-alias 'org-delete-directory 'delete-directory "9.0")
  262. (define-obsolete-function-alias 'org-format-seconds 'format-seconds "9.0")
  263. (define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "9.0")
  264. (define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "9.0")
  265. (define-obsolete-function-alias 'org-number-sequence 'number-sequence "9.0")
  266. (define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "9.0")
  267. (define-obsolete-function-alias 'org-string-match-p 'string-match-p "9.0")
  268. ;;;; Functions and variables from previous releases now obsolete.
  269. (define-obsolete-function-alias 'org-element-remove-indentation
  270. 'org-remove-indentation "9.0")
  271. (define-obsolete-variable-alias 'org-latex-create-formula-image-program
  272. 'org-preview-latex-default-process "9.0")
  273. (define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
  274. 'org-preview-latex-image-directory "9.0")
  275. (define-obsolete-function-alias 'org-table-p 'org-at-table-p "9.0")
  276. (define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "9.0")
  277. (define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "8.3")
  278. (define-obsolete-function-alias 'org-image-file-name-regexp
  279. 'image-file-name-regexp "9.0")
  280. (define-obsolete-function-alias 'org-completing-read-no-i
  281. 'completing-read "9.0")
  282. (define-obsolete-function-alias 'org-icompleting-read
  283. 'completing-read "9.0")
  284. (define-obsolete-function-alias 'org-iread-file-name 'read-file-name "9.0")
  285. (define-obsolete-function-alias 'org-days-to-time
  286. 'org-time-stamp-to-now "8.2")
  287. (define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties
  288. 'org-agenda-ignore-properties "9.0")
  289. (define-obsolete-function-alias 'org-preview-latex-fragment
  290. 'org-toggle-latex-fragment "8.3")
  291. (define-obsolete-function-alias 'org-export-get-genealogy
  292. 'org-element-lineage "9.0")
  293. (define-obsolete-variable-alias 'org-latex-with-hyperref
  294. 'org-latex-hyperref-template "9.0")
  295. (define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "9.0")
  296. (define-obsolete-variable-alias 'org-export-htmlized-org-css-url
  297. 'org-org-htmlized-css-url "8.2")
  298. (define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "9.0")
  299. (define-obsolete-function-alias 'org-agenda-todayp
  300. 'org-agenda-today-p "9.0")
  301. (define-obsolete-function-alias 'org-babel-examplize-region
  302. 'org-babel-examplify-region "9.0")
  303. (define-obsolete-variable-alias 'org-babel-capitalize-example-region-markers
  304. 'org-babel-uppercase-example-markers "9.1")
  305. (define-obsolete-function-alias 'org-babel-trim 'org-trim "9.0")
  306. (define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
  307. (define-obsolete-function-alias 'org-insert-columns-dblock
  308. 'org-columns-insert-dblock "9.0")
  309. (define-obsolete-variable-alias 'org-export-babel-evaluate
  310. 'org-export-use-babel "9.1")
  311. (define-obsolete-function-alias 'org-activate-bracket-links
  312. 'org-activate-links "9.0")
  313. (define-obsolete-function-alias 'org-activate-plain-links 'ignore "9.0")
  314. (define-obsolete-function-alias 'org-activate-angle-links 'ignore "9.0")
  315. (define-obsolete-function-alias 'org-remove-double-quotes 'org-strip-quotes "9.0")
  316. (define-obsolete-function-alias 'org-get-indentation
  317. 'current-indentation "9.2")
  318. (define-obsolete-function-alias 'org-capture-member 'org-capture-get "9.2")
  319. (define-obsolete-function-alias 'org-remove-from-invisibility-spec
  320. 'remove-from-invisibility-spec "9.2")
  321. (define-obsolete-variable-alias 'org-effort-durations 'org-duration-units
  322. "9.2")
  323. (define-obsolete-function-alias 'org-toggle-latex-fragment 'org-latex-preview
  324. "9.3")
  325. (define-obsolete-function-alias 'org-remove-latex-fragment-image-overlays
  326. 'org-clear-latex-preview "9.3")
  327. (define-obsolete-variable-alias 'org-attach-directory
  328. 'org-attach-id-dir "9.3")
  329. (make-obsolete 'org-attach-store-link "No longer used" "9.4")
  330. (make-obsolete 'org-attach-expand-link "No longer used" "9.4")
  331. (define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.5")
  332. (defun org-in-fixed-width-region-p ()
  333. "Non-nil if point in a fixed-width region."
  334. (save-match-data
  335. (eq 'fixed-width (org-element-type (org-element-at-point)))))
  336. (make-obsolete 'org-in-fixed-width-region-p
  337. "use `org-element' library"
  338. "9.0")
  339. (defun org-compatible-face (inherits specs)
  340. "Make a compatible face specification.
  341. If INHERITS is an existing face and if the Emacs version supports
  342. it, just inherit the face. If INHERITS is not given and SPECS
  343. is, use SPECS to define the face."
  344. (declare (indent 1))
  345. (if (facep inherits)
  346. (list (list t :inherit inherits))
  347. specs))
  348. (make-obsolete 'org-compatible-face "you can remove it." "9.0")
  349. (defun org-add-link-type (type &optional follow export)
  350. "Add a new TYPE link.
  351. FOLLOW and EXPORT are two functions.
  352. FOLLOW should take the link path as the single argument and do whatever
  353. is necessary to follow the link, for example find a file or display
  354. a mail message.
  355. EXPORT should format the link path for export to one of the export formats.
  356. It should be a function accepting three arguments:
  357. path the path of the link, the text after the prefix (like \"http:\")
  358. desc the description of the link, if any
  359. format the export format, a symbol like `html' or `latex' or `ascii'.
  360. The function may use the FORMAT information to return different values
  361. depending on the format. The return value will be put literally into
  362. the exported file. If the return value is nil, this means Org should
  363. do what it normally does with links which do not have EXPORT defined.
  364. Org mode has a built-in default for exporting links. If you are happy with
  365. this default, there is no need to define an export function for the link
  366. type. For a simple example of an export function, see `org-bbdb.el'.
  367. If TYPE already exists, update it with the arguments.
  368. See `org-link-parameters' for documentation on the other parameters."
  369. (org-link-set-parameters type :follow follow :export export)
  370. (message "Created %s link." type))
  371. (make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "9.0")
  372. ;;;; Functions unused in Org core.
  373. (defun org-table-recognize-table.el ()
  374. "If there is a table.el table nearby, recognize it and move into it."
  375. (when (org-at-table.el-p)
  376. (beginning-of-line)
  377. (unless (or (looking-at org-table-dataline-regexp)
  378. (not (looking-at org-table1-hline-regexp)))
  379. (forward-line)
  380. (when (looking-at org-table-any-border-regexp)
  381. (forward-line -2)))
  382. (if (re-search-forward "|" (org-table-end t) t)
  383. (progn
  384. (require 'table)
  385. (if (table--at-cell-p (point)) t
  386. (message "recognizing table.el table...")
  387. (table-recognize-table)
  388. (message "recognizing table.el table...done")))
  389. (error "This should not happen"))))
  390. ;; Not used since commit 6d1e3082, Feb 2010.
  391. (make-obsolete 'org-table-recognize-table.el
  392. "please notify Org mailing list if you use this function."
  393. "9.0")
  394. (defmacro org-preserve-lc (&rest body)
  395. (declare (debug (body))
  396. (obsolete "please notify Org mailing list if you use this function."
  397. "9.2"))
  398. (org-with-gensyms (line col)
  399. `(let ((,line (org-current-line))
  400. (,col (current-column)))
  401. (unwind-protect
  402. (progn ,@body)
  403. (org-goto-line ,line)
  404. (org-move-to-column ,col)))))
  405. (defun org-version-check (version &rest _)
  406. "Non-nil if VERSION is lower (older) than `emacs-version'."
  407. (declare (obsolete "use `version<' or `fboundp' instead."
  408. "9.2"))
  409. (version< version emacs-version))
  410. (defun org-remove-angle-brackets (s)
  411. (org-unbracket-string "<" ">" s))
  412. (make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "9.0")
  413. (defcustom org-publish-sitemap-file-entry-format "%t"
  414. "Format string for site-map file entry.
  415. You could use brackets to delimit on what part the link will be.
  416. %t is the title.
  417. %a is the author.
  418. %d is the date formatted using `org-publish-sitemap-date-format'."
  419. :group 'org-export-publish
  420. :type 'string)
  421. (make-obsolete-variable
  422. 'org-publish-sitemap-file-entry-format
  423. "set `:sitemap-format-entry' in `org-publish-project-alist' instead."
  424. "9.1")
  425. (defvar org-agenda-skip-regexp)
  426. (defun org-agenda-skip-entry-when-regexp-matches ()
  427. "Check if the current entry contains match for `org-agenda-skip-regexp'.
  428. If yes, it returns the end position of this entry, causing agenda commands
  429. to skip the entry but continuing the search in the subtree. This is a
  430. function that can be put into `org-agenda-skip-function' for the duration
  431. of a command."
  432. (declare (obsolete "use `org-agenda-skip-if' instead." "9.1"))
  433. (let ((end (save-excursion (org-end-of-subtree t)))
  434. skip)
  435. (save-excursion
  436. (setq skip (re-search-forward org-agenda-skip-regexp end t)))
  437. (and skip end)))
  438. (defun org-agenda-skip-subtree-when-regexp-matches ()
  439. "Check if the current subtree contains match for `org-agenda-skip-regexp'.
  440. If yes, it returns the end position of this tree, causing agenda commands
  441. to skip this subtree. This is a function that can be put into
  442. `org-agenda-skip-function' for the duration of a command."
  443. (declare (obsolete "use `org-agenda-skip-if' instead." "9.1"))
  444. (let ((end (save-excursion (org-end-of-subtree t)))
  445. skip)
  446. (save-excursion
  447. (setq skip (re-search-forward org-agenda-skip-regexp end t)))
  448. (and skip end)))
  449. (defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
  450. "Check if the current subtree contains match for `org-agenda-skip-regexp'.
  451. If yes, it returns the end position of the current entry (NOT the tree),
  452. causing agenda commands to skip the entry but continuing the search in
  453. the subtree. This is a function that can be put into
  454. `org-agenda-skip-function' for the duration of a command. An important
  455. use of this function is for the stuck project list."
  456. (declare (obsolete "use `org-agenda-skip-if' instead." "9.1"))
  457. (let ((end (save-excursion (org-end-of-subtree t)))
  458. (entry-end (save-excursion (outline-next-heading) (1- (point))))
  459. skip)
  460. (save-excursion
  461. (setq skip (re-search-forward org-agenda-skip-regexp end t)))
  462. (and skip entry-end)))
  463. (define-obsolete-function-alias 'org-minutes-to-clocksum-string
  464. 'org-duration-from-minutes "9.1")
  465. (define-obsolete-function-alias 'org-hh:mm-string-to-minutes
  466. 'org-duration-to-minutes "9.1")
  467. (define-obsolete-function-alias 'org-duration-string-to-minutes
  468. 'org-duration-to-minutes "9.1")
  469. (make-obsolete-variable 'org-time-clocksum-format
  470. "set `org-duration-format' instead." "9.1")
  471. (make-obsolete-variable 'org-time-clocksum-use-fractional
  472. "set `org-duration-format' instead." "9.1")
  473. (make-obsolete-variable 'org-time-clocksum-fractional-format
  474. "set `org-duration-format' instead." "9.1")
  475. (make-obsolete-variable 'org-time-clocksum-use-effort-durations
  476. "set `org-duration-units' instead." "9.1")
  477. (define-obsolete-function-alias 'org-babel-number-p
  478. 'org-babel--string-to-number "9.0")
  479. (define-obsolete-variable-alias 'org-usenet-links-prefer-google
  480. 'org-gnus-prefer-web-links "9.1")
  481. (define-obsolete-variable-alias 'org-texinfo-def-table-markup
  482. 'org-texinfo-table-default-markup "9.1")
  483. (define-obsolete-variable-alias 'org-agenda-overriding-columns-format
  484. 'org-overriding-columns-format "9.2.2")
  485. (define-obsolete-variable-alias 'org-doi-server-url
  486. 'org-link-doi-server-url "9.3")
  487. (define-obsolete-variable-alias 'org-email-link-description-format
  488. 'org-link-email-description-format "9.3")
  489. (define-obsolete-variable-alias 'org-make-link-description-function
  490. 'org-link-make-description-function "9.3")
  491. (define-obsolete-variable-alias 'org-from-is-user-regexp
  492. 'org-link-from-user-regexp "9.3")
  493. (define-obsolete-variable-alias 'org-descriptive-links
  494. 'org-link-descriptive "9.3")
  495. (define-obsolete-variable-alias 'org-context-in-file-links
  496. 'org-link-context-for-files "9.3")
  497. (define-obsolete-variable-alias 'org-keep-stored-link-after-insertion
  498. 'org-link-keep-stored-after-insertion "9.3")
  499. (define-obsolete-variable-alias 'org-display-internal-link-with-indirect-buffer
  500. 'org-link-use-indirect-buffer-for-internals "9.3")
  501. (define-obsolete-variable-alias 'org-confirm-shell-link-function
  502. 'org-link-shell-confirm-function "9.3")
  503. (define-obsolete-variable-alias 'org-confirm-shell-link-not-regexp
  504. 'org-link-shell-skip-confirm-regexp "9.3")
  505. (define-obsolete-variable-alias 'org-confirm-elisp-link-function
  506. 'org-link-elisp-confirm-function "9.3")
  507. (define-obsolete-variable-alias 'org-confirm-elisp-link-not-regexp
  508. 'org-link-elisp-skip-confirm-regexp "9.3")
  509. (define-obsolete-function-alias 'org-file-complete-link
  510. 'org-link-complete-file "9.3")
  511. (define-obsolete-function-alias 'org-email-link-description
  512. 'org-link-email-description "9.3")
  513. (define-obsolete-function-alias 'org-make-link-string
  514. 'org-link-make-string "9.3")
  515. (define-obsolete-function-alias 'org-store-link-props
  516. 'org-link-store-props "9.3")
  517. (define-obsolete-function-alias 'org-add-link-props
  518. 'org-link-add-props "9.3")
  519. (define-obsolete-function-alias 'org-make-org-heading-search-string
  520. 'org-link-heading-search-string "9.3")
  521. (define-obsolete-function-alias 'org-make-link-regexps
  522. 'org-link-make-regexps "9.3")
  523. (define-obsolete-function-alias 'org-property-global-value
  524. 'org-property-global-or-keyword-value "9.3")
  525. (make-obsolete-variable 'org-file-properties 'org-keyword-properties "9.3")
  526. (define-obsolete-variable-alias 'org-angle-link-re
  527. 'org-link-angle-re "9.3")
  528. (define-obsolete-variable-alias 'org-plain-link-re
  529. 'org-link-plain-re "9.3")
  530. (define-obsolete-variable-alias 'org-bracket-link-regexp
  531. 'org-link-bracket-re "9.3")
  532. (define-obsolete-variable-alias 'org-bracket-link-analytic-regexp
  533. 'org-link-bracket-re "9.3")
  534. (define-obsolete-variable-alias 'org-any-link-re
  535. 'org-link-any-re "9.3")
  536. (define-obsolete-function-alias 'org-open-link-from-string
  537. 'org-link-open-from-string "9.3")
  538. (define-obsolete-function-alias 'org-add-angle-brackets
  539. 'org-link-add-angle-brackets "9.3")
  540. ;; The function was made obsolete by commit 65399674d5 of 2013-02-22.
  541. ;; This make-obsolete call was added 2016-09-01.
  542. (make-obsolete 'org-capture-import-remember-templates
  543. "use the `org-capture-templates' variable instead."
  544. "9.0")
  545. (defun org-show-block-all ()
  546. "Unfold all blocks in the current buffer."
  547. (interactive)
  548. (org-fold-show-all '(blocks)))
  549. (make-obsolete 'org-show-block-all
  550. "use `org-show-all' instead."
  551. "9.2")
  552. (define-obsolete-function-alias 'org-get-tags-at 'org-get-tags "9.2")
  553. (defun org-get-local-tags ()
  554. "Get a list of tags defined in the current headline."
  555. (declare (obsolete "use `org-get-tags' instead." "9.2"))
  556. (org-get-tags nil 'local))
  557. (defun org-get-local-tags-at (&optional pos)
  558. "Get a list of tags defined in the current headline."
  559. (declare (obsolete "use `org-get-tags' instead." "9.2"))
  560. (org-get-tags pos 'local))
  561. (defun org-get-tags-string ()
  562. "Get the TAGS string in the current headline."
  563. (declare (obsolete "use `org-make-tag-string' instead." "9.2"))
  564. (org-make-tag-string (org-get-tags nil t)))
  565. (define-obsolete-function-alias 'org-set-tags-to 'org-set-tags "9.2")
  566. (defun org-align-all-tags ()
  567. "Align the tags in all headings."
  568. (declare (obsolete "use `org-align-tags' instead." "9.2"))
  569. (org-align-tags t))
  570. (define-obsolete-function-alias
  571. 'org-at-property-block-p 'org-at-property-drawer-p "9.4")
  572. (defun org-flag-drawer (flag &optional element beg end)
  573. "When FLAG is non-nil, hide the drawer we are at.
  574. Otherwise make it visible.
  575. When optional argument ELEMENT is a parsed drawer, as returned by
  576. `org-element-at-point', hide or show that drawer instead.
  577. When buffer positions BEG and END are provided, hide or show that
  578. region as a drawer without further ado."
  579. (declare (obsolete "use `org-hide-drawer-toggle' instead." "9.4"))
  580. (if (and beg end) (org-fold-region beg end flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
  581. (let ((drawer
  582. (or element
  583. (and (save-excursion
  584. (beginning-of-line)
  585. (looking-at-p "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$"))
  586. (org-element-at-point)))))
  587. (when (memq (org-element-type drawer) '(drawer property-drawer))
  588. (let ((post (org-element-property :post-affiliated drawer)))
  589. (org-fold-region
  590. (save-excursion (goto-char post) (line-end-position))
  591. (save-excursion (goto-char (org-element-property :end drawer))
  592. (skip-chars-backward " \t\n")
  593. (line-end-position))
  594. flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
  595. ;; When the drawer is hidden away, make sure point lies in
  596. ;; a visible part of the buffer.
  597. (when (invisible-p (max (1- (point)) (point-min)))
  598. (goto-char post)))))))
  599. (defun org-hide-block-toggle-maybe ()
  600. "Toggle visibility of block at point.
  601. Unlike to `org-hide-block-toggle', this function does not throw
  602. an error. Return a non-nil value when toggling is successful."
  603. (declare (obsolete "use `org-hide-block-toggle' instead." "9.4"))
  604. (interactive)
  605. (org-fold-hide-block-toggle nil t))
  606. (defun org-hide-block-toggle-all ()
  607. "Toggle the visibility of all blocks in the current buffer."
  608. (declare (obsolete "please notify Org mailing list if you use this function."
  609. "9.4"))
  610. (let ((start (point-min))
  611. (end (point-max)))
  612. (save-excursion
  613. (goto-char start)
  614. (while (and (< (point) end)
  615. (re-search-forward "^[ \t]*#\\+begin_?\
  616. \\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" end t))
  617. (save-excursion
  618. (save-match-data
  619. (goto-char (match-beginning 0))
  620. (org-fold-hide-block-toggle)))))))
  621. (defun org-return-indent ()
  622. "Goto next table row or insert a newline and indent.
  623. Calls `org-table-next-row' or `newline-and-indent', depending on
  624. context. See the individual commands for more information."
  625. (declare (obsolete "use `org-return' with INDENT set to t instead."
  626. "9.4"))
  627. (interactive)
  628. (org-return t))
  629. (defmacro org-with-silent-modifications (&rest body)
  630. (declare (obsolete "use `with-silent-modifications' instead." "9.2")
  631. (debug (body)))
  632. `(with-silent-modifications ,@body))
  633. (define-obsolete-function-alias 'org-babel-strip-quotes
  634. 'org-strip-quotes "9.2")
  635. (define-obsolete-variable-alias 'org-sort-agenda-notime-is-late
  636. 'org-agenda-sort-notime-is-late "9.4")
  637. (define-obsolete-variable-alias 'org-sort-agenda-noeffort-is-high
  638. 'org-agenda-sort-noeffort-is-high "9.4")
  639. (defconst org-maybe-keyword-time-regexp
  640. (concat "\\(\\<\\(\\(?:CLO\\(?:CK\\|SED\\)\\|DEADLINE\\|SCHEDULED\\):\\)\\)?"
  641. " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*[]>]"
  642. "\\|"
  643. "<%%([^\r\n>]*>\\)")
  644. "Matches a timestamp, possibly preceded by a keyword.")
  645. (make-obsolete-variable
  646. 'org-maybe-keyword-time-regexp
  647. "use `org-planning-line-re', followed by `org-ts-regexp-both' instead."
  648. "9.4")
  649. (define-obsolete-function-alias 'org-copy 'org-refile-copy "9.4")
  650. (define-obsolete-function-alias 'org-get-last-sibling 'org-get-previous-sibling "9.4")
  651. (define-obsolete-function-alias 'org-truely-invisible-p
  652. 'org-truly-invisible-p "9.6"
  653. "Compatibility alias for legacy misspelling of `org-truly-invisible-p'.")
  654. ;;;; Obsolete link types
  655. (eval-after-load 'ol
  656. '(progn
  657. (org-link-set-parameters "file+emacs") ;since Org 9.0
  658. (org-link-set-parameters "file+sys"))) ;since Org 9.0
  659. ;;; Miscellaneous functions
  660. (defun org-get-x-clipboard (value)
  661. "Get the value of the X or Windows clipboard."
  662. (cond ((and (eq window-system 'x)
  663. (fboundp 'gui-get-selection)) ;Silence byte-compiler.
  664. (org-no-properties
  665. (ignore-errors
  666. (or (gui-get-selection value 'UTF8_STRING)
  667. (gui-get-selection value 'COMPOUND_TEXT)
  668. (gui-get-selection value 'STRING)
  669. (gui-get-selection value 'TEXT)))))
  670. ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
  671. (w32-get-clipboard-data))))
  672. ;; `set-transient-map' is only in Emacs >= 24.4
  673. (defalias 'org-set-transient-map
  674. (if (fboundp 'set-transient-map)
  675. 'set-transient-map
  676. 'set-temporary-overlay-map))
  677. ;;; Region compatibility
  678. (defvar org-ignore-region nil
  679. "Non-nil means temporarily disable the active region.")
  680. (defun org-region-active-p ()
  681. "Non-nil when the region active.
  682. Unlike to `use-region-p', this function also checks
  683. `org-ignore-region'."
  684. (and (not org-ignore-region) (use-region-p)))
  685. (defun org-cursor-to-region-beginning ()
  686. (when (and (org-region-active-p)
  687. (> (point) (region-beginning)))
  688. (exchange-point-and-mark)))
  689. ;;; Invisibility compatibility
  690. (defun org-in-invisibility-spec-p (arg)
  691. "Is ARG a member of `buffer-invisibility-spec'?"
  692. (when (consp buffer-invisibility-spec)
  693. (member arg buffer-invisibility-spec)))
  694. (defun org-move-to-column (column &optional force _buffer)
  695. "Move to column COLUMN.
  696. Pass COLUMN and FORCE to `move-to-column'."
  697. (let ((buffer-invisibility-spec
  698. (if (listp buffer-invisibility-spec)
  699. (remove '(org-filtered) buffer-invisibility-spec)
  700. buffer-invisibility-spec)))
  701. (move-to-column column force)))
  702. (defmacro org-find-library-dir (library)
  703. `(file-name-directory (or (locate-library ,library) "")))
  704. (defun org-count-lines (s)
  705. "How many lines in string S?"
  706. (let ((start 0) (n 1))
  707. (while (string-match "\n" s start)
  708. (setq start (match-end 0) n (1+ n)))
  709. (when (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
  710. (setq n (1- n)))
  711. n))
  712. (defun org-kill-new (string &rest args)
  713. (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
  714. string)
  715. (apply 'kill-new string args))
  716. ;; `font-lock-ensure' is only available from 24.4.50 on
  717. (defalias 'org-font-lock-ensure
  718. (if (fboundp 'font-lock-ensure)
  719. #'font-lock-ensure
  720. (lambda (&optional _beg _end)
  721. (with-no-warnings (font-lock-fontify-buffer)))))
  722. ;; `file-local-name' was added in Emacs 26.1.
  723. (defalias 'org-babel-local-file-name
  724. (if (fboundp 'file-local-name)
  725. 'file-local-name
  726. (lambda (file)
  727. "Return the local name component of FILE."
  728. (or (file-remote-p file 'localname) file))))
  729. ;;;###autoload
  730. (defmacro org-check-version ()
  731. "Try very hard to provide sensible version strings."
  732. (let* ((org-dir (org-find-library-dir "org"))
  733. (org-version.el (concat org-dir "org-version.el"))
  734. (org-fixup.el (concat org-dir "../mk/org-fixup.el")))
  735. (if (require 'org-version org-version.el 'noerror)
  736. '(progn
  737. (autoload 'org-release "org-version.el")
  738. (autoload 'org-git-version "org-version.el"))
  739. (if (require 'org-fixup org-fixup.el 'noerror)
  740. '(org-fixup)
  741. ;; provide fallback definitions and complain
  742. (warn "Could not define org version correctly. Check installation!")
  743. '(progn
  744. (defun org-release () "N/A")
  745. (defun org-git-version () "N/A !!check installation!!"))))))
  746. ;;; Functions for Emacs < 24.4 compatibility
  747. (defun org-define-error (name message)
  748. "Define NAME as a new error signal.
  749. MESSAGE is a string that will be output to the echo area if such
  750. an error is signaled without being caught by a `condition-case'.
  751. Implements `define-error' for older emacsen."
  752. (if (fboundp 'define-error) (define-error name message)
  753. (put name 'error-conditions
  754. (copy-sequence (cons name (get 'error 'error-conditions))))))
  755. (unless (fboundp 'string-suffix-p)
  756. ;; From Emacs subr.el.
  757. (defun string-suffix-p (suffix string &optional ignore-case)
  758. "Return non-nil if SUFFIX is a suffix of STRING.
  759. If IGNORE-CASE is non-nil, the comparison is done without paying
  760. attention to case differences."
  761. (let ((start-pos (- (length string) (length suffix))))
  762. (and (>= start-pos 0)
  763. (eq t (compare-strings suffix nil nil
  764. string start-pos nil ignore-case))))))
  765. ;;; Integration with and fixes for other packages
  766. (defgroup org-imenu-and-speedbar nil
  767. "Options concerning imenu and speedbar in Org mode."
  768. :tag "Org Imenu and Speedbar"
  769. :group 'org-structure)
  770. (defcustom org-imenu-depth 2
  771. "The maximum level for Imenu access to Org headlines.
  772. This also applied for speedbar access."
  773. :type 'integer)
  774. ;;;; Imenu
  775. (defvar-local org-imenu-markers nil
  776. "All markers currently used by Imenu.")
  777. (defun org-imenu-get-tree ()
  778. "Produce the index for Imenu."
  779. (dolist (x org-imenu-markers) (move-marker x nil))
  780. (setq org-imenu-markers nil)
  781. (org-with-wide-buffer
  782. (goto-char (point-max))
  783. (let* ((re (concat "^" (org-get-limited-outline-regexp)))
  784. (subs (make-vector (1+ org-imenu-depth) nil))
  785. (last-level 0))
  786. (while (re-search-backward re nil t)
  787. (let ((level (org-reduced-level (funcall outline-level)))
  788. (headline (org-no-properties
  789. (org-link-display-format (org-get-heading t t t t)))))
  790. (when (and (<= level org-imenu-depth) (org-string-nw-p headline))
  791. (let* ((m (point-marker))
  792. (item (propertize headline 'org-imenu-marker m 'org-imenu t)))
  793. (push m org-imenu-markers)
  794. (if (>= level last-level)
  795. (push (cons item m) (aref subs level))
  796. (push (cons item
  797. (cl-mapcan #'identity (cl-subseq subs (1+ level))))
  798. (aref subs level))
  799. (cl-loop for i from (1+ level) to org-imenu-depth
  800. do (aset subs i nil)))
  801. (setq last-level level)))))
  802. (aref subs 1))))
  803. (eval-after-load 'imenu
  804. '(progn
  805. (add-hook 'imenu-after-jump-hook
  806. (lambda ()
  807. (when (derived-mode-p 'org-mode)
  808. (org-fold-show-context 'org-goto))))
  809. (add-hook 'org-mode-hook
  810. (lambda ()
  811. (setq imenu-create-index-function 'org-imenu-get-tree)))))
  812. ;;;; Speedbar
  813. (defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
  814. "Overlay marking the agenda restriction line in speedbar.")
  815. (overlay-put org-speedbar-restriction-lock-overlay
  816. 'face 'org-agenda-restriction-lock)
  817. (overlay-put org-speedbar-restriction-lock-overlay
  818. 'help-echo "Agendas are currently limited to this item.")
  819. (delete-overlay org-speedbar-restriction-lock-overlay)
  820. (defun org-speedbar-set-agenda-restriction ()
  821. "Restrict future agenda commands to the location at point in speedbar.
  822. If there is already a restriction lock at the location, remove it.
  823. To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
  824. (interactive)
  825. (require 'org-agenda)
  826. (let (p m tp np dir txt)
  827. (cond
  828. ((setq p (text-property-any (point-at-bol) (point-at-eol)
  829. 'org-imenu t))
  830. (setq m (get-text-property p 'org-imenu-marker))
  831. (with-current-buffer (marker-buffer m)
  832. (goto-char m)
  833. (if (and org-agenda-overriding-restriction
  834. (member org-agenda-restriction-lock-overlay
  835. (overlays-at (point))))
  836. (org-agenda-remove-restriction-lock 'noupdate)
  837. (org-agenda-set-restriction-lock 'subtree))))
  838. ((setq p (text-property-any (point-at-bol) (point-at-eol)
  839. 'speedbar-function 'speedbar-find-file))
  840. (setq tp (previous-single-property-change
  841. (1+ p) 'speedbar-function)
  842. np (next-single-property-change
  843. tp 'speedbar-function)
  844. dir (speedbar-line-directory)
  845. txt (buffer-substring-no-properties (or tp (point-min))
  846. (or np (point-max))))
  847. (with-current-buffer (find-file-noselect
  848. (let ((default-directory dir))
  849. (expand-file-name txt)))
  850. (unless (derived-mode-p 'org-mode)
  851. (user-error "Cannot restrict to non-Org mode file"))
  852. (org-agenda-set-restriction-lock 'file)))
  853. (t (user-error "Don't know how to restrict Org mode agenda")))
  854. (move-overlay org-speedbar-restriction-lock-overlay
  855. (point-at-bol) (point-at-eol))
  856. (setq current-prefix-arg nil)
  857. (org-agenda-maybe-redo)))
  858. (defvar speedbar-file-key-map)
  859. (declare-function speedbar-add-supported-extension "speedbar" (extension))
  860. (eval-after-load 'speedbar
  861. '(progn
  862. (speedbar-add-supported-extension ".org")
  863. (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
  864. (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
  865. (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
  866. (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
  867. (add-hook 'speedbar-visiting-tag-hook
  868. (lambda () (and (derived-mode-p 'org-mode) (org-fold-show-context 'org-goto))))))
  869. ;;;; Add Log
  870. (defun org-add-log-current-headline ()
  871. "Return current headline or nil.
  872. This function ignores inlinetasks. It is meant to be used as
  873. `add-log-current-defun-function' value."
  874. (org-with-limited-levels (org-get-heading t t t t)))
  875. ;;;; Flyspell
  876. (defun org--flyspell-object-check-p (element)
  877. "Non-nil when Flyspell can check object at point.
  878. ELEMENT is the element at point."
  879. (let ((object (save-excursion
  880. (when (looking-at-p "\\>") (backward-char))
  881. (org-element-context element))))
  882. (cl-case (org-element-type object)
  883. ;; Prevent checks in links due to keybinding conflict with
  884. ;; Flyspell.
  885. ((citation citation-reference code entity export-snippet inline-babel-call
  886. inline-src-block line-break latex-fragment link macro
  887. statistics-cookie target timestamp verbatim)
  888. nil)
  889. (footnote-reference
  890. ;; Only in inline footnotes, within the definition.
  891. (and (eq (org-element-property :type object) 'inline)
  892. (< (save-excursion
  893. (goto-char (org-element-property :begin object))
  894. (search-forward ":" nil t 2))
  895. (point))))
  896. (otherwise t))))
  897. (defun org-mode-flyspell-verify ()
  898. "Function used for `flyspell-generic-check-word-predicate'."
  899. (if (org-at-heading-p)
  900. ;; At a headline or an inlinetask, check title only.
  901. (and (save-excursion (beginning-of-line)
  902. (and (let ((case-fold-search t))
  903. (not (looking-at-p "\\*+ END[ \t]*$")))
  904. (let ((case-fold-search nil))
  905. (looking-at org-complex-heading-regexp))))
  906. (match-beginning 4)
  907. (>= (point) (match-beginning 4))
  908. (or (not (match-beginning 5))
  909. (< (point) (match-beginning 5)))
  910. ;; Ignore checks in code, verbatim and others.
  911. (org--flyspell-object-check-p (org-element-at-point-no-context)))
  912. (let* ((element (org-element-at-point-no-context))
  913. (post-affiliated (org-element-property :post-affiliated element)))
  914. (cond
  915. ;; Ignore checks in all affiliated keywords but captions.
  916. ((< (point) post-affiliated)
  917. (and (save-excursion
  918. (beginning-of-line)
  919. (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
  920. (> (point) (match-end 0))
  921. (org--flyspell-object-check-p element)))
  922. ;; Ignore checks in LOGBOOK (or equivalent) drawer.
  923. ((let ((log (org-log-into-drawer)))
  924. (and log
  925. (let ((drawer (org-element-lineage element '(drawer))))
  926. (and drawer
  927. (eq (compare-strings
  928. log nil nil
  929. (org-element-property :drawer-name drawer) nil nil t)
  930. t)))))
  931. nil)
  932. (t
  933. (cl-case (org-element-type element)
  934. ((comment quote-section) t)
  935. (comment-block
  936. ;; Allow checks between block markers, not on them.
  937. (and (> (line-beginning-position) post-affiliated)
  938. (save-excursion
  939. (end-of-line)
  940. (skip-chars-forward " \r\t\n")
  941. (< (point) (org-element-property :end element)))))
  942. ;; Arbitrary list of keywords where checks are meaningful.
  943. ;; Make sure point is on the value part of the element.
  944. (keyword
  945. (and (member (org-element-property :key element)
  946. '("DESCRIPTION" "TITLE"))
  947. (save-excursion
  948. (search-backward ":" (line-beginning-position) t))))
  949. ;; Check is globally allowed in paragraphs verse blocks and
  950. ;; table rows (after affiliated keywords) but some objects
  951. ;; must not be affected.
  952. ((paragraph table-row verse-block)
  953. (let ((cbeg (org-element-property :contents-begin element))
  954. (cend (org-element-property :contents-end element)))
  955. (and cbeg (>= (point) cbeg) (< (point) cend)
  956. (org--flyspell-object-check-p element))))))))))
  957. (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
  958. (defun org-remove-flyspell-overlays-in (beg end)
  959. "Remove flyspell overlays in region."
  960. (and (bound-and-true-p flyspell-mode)
  961. (fboundp 'flyspell-delete-region-overlays)
  962. (flyspell-delete-region-overlays beg end)))
  963. (defvar flyspell-delayed-commands)
  964. (eval-after-load 'flyspell
  965. '(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
  966. ;;;; Bookmark
  967. (defun org-bookmark-jump-unhide (&rest _)
  968. "Unhide the current position, to show the bookmark location."
  969. (and (derived-mode-p 'org-mode)
  970. (or (org-invisible-p)
  971. (save-excursion (goto-char (max (point-min) (1- (point))))
  972. (org-invisible-p)))
  973. (org-fold-show-context 'bookmark-jump)))
  974. ;; Make `bookmark-jump' shows the jump location if it was hidden.
  975. (add-hook 'bookmark-after-jump-hook #'org-bookmark-jump-unhide)
  976. ;;;; Calendar
  977. (defcustom org-calendar-to-agenda-key 'default
  978. "Key to be installed in `calendar-mode-map' for switching to the agenda.
  979. The command `org-calendar-goto-agenda' will be bound to this key.
  980. When set to `default', bind the function to `c', but only if it is
  981. available in the Calendar keymap. This is the default choice because
  982. `c' can then be used to switch back and forth between agenda and calendar.
  983. When nil, `org-calendar-goto-agenda' is not bound to any key."
  984. :group 'org-agenda
  985. :type '(choice
  986. (const :tag "Bind to `c' if available" default)
  987. (key-sequence :tag "Other binding")
  988. (const :tag "No binding" nil))
  989. :safe (lambda (v) (or (symbolp v) (stringp v)))
  990. :package-version '(Org . "9.2"))
  991. (defcustom org-calendar-insert-diary-entry-key [?i]
  992. "The key to be installed in `calendar-mode-map' for adding diary entries.
  993. This option is irrelevant until `org-agenda-diary-file' has been configured
  994. to point to an Org file. When that is the case, the command
  995. `org-agenda-diary-entry' will be bound to the key given here, by default
  996. `i'. In the calendar, `i' normally adds entries to `diary-file'. So
  997. if you want to continue doing this, you need to change this to a different
  998. key."
  999. :group 'org-agenda
  1000. :type 'sexp)
  1001. (defun org--setup-calendar-bindings ()
  1002. "Bind Org functions in Calendar keymap."
  1003. (pcase org-calendar-to-agenda-key
  1004. (`nil nil)
  1005. ((and key (pred stringp))
  1006. (local-set-key (kbd key) #'org-calendar-goto-agenda))
  1007. ((guard (not (lookup-key calendar-mode-map "c")))
  1008. (local-set-key "c" #'org-calendar-goto-agenda))
  1009. (_ nil))
  1010. (when (and (boundp 'org-agenda-diary-file)
  1011. (not (eq org-agenda-diary-file 'diary-file)))
  1012. (local-set-key org-calendar-insert-diary-entry-key
  1013. #'org-agenda-diary-entry)))
  1014. (eval-after-load 'calendar
  1015. '(add-hook 'calendar-mode-hook #'org--setup-calendar-bindings))
  1016. ;;;; Saveplace
  1017. ;; Make sure saveplace shows the location if it was hidden
  1018. (advice-add 'save-place-find-file-hook :after #'org-bookmark-jump-unhide)
  1019. ;;;; Ecb
  1020. ;; Make sure ecb shows the location if it was hidden
  1021. (advice-add 'ecb-method-clicked :after #'org--ecb-show-context)
  1022. (defun org--ecb-show-context (&rest _)
  1023. "Make hierarchy visible when jumping into location from ECB tree buffer."
  1024. (when (derived-mode-p 'org-mode)
  1025. (org-fold-show-context)))
  1026. ;;;; Simple
  1027. (defun org-mark-jump-unhide (&rest _)
  1028. "Make the point visible with `org-show-context' after jumping to the mark."
  1029. (when (and (derived-mode-p 'org-mode)
  1030. (org-invisible-p))
  1031. (org-fold-show-context 'mark-goto)))
  1032. (advice-add 'pop-to-mark-command :after #'org-mark-jump-unhide)
  1033. (advice-add 'exchange-point-and-mark :after #'org-mark-jump-unhide)
  1034. (advice-add 'pop-global-mark :after #'org-mark-jump-unhide)
  1035. ;;;; Session
  1036. ;; Make "session.el" ignore our circular variable.
  1037. (defvar session-globals-exclude)
  1038. (eval-after-load 'session
  1039. '(add-to-list 'session-globals-exclude 'org-mark-ring))
  1040. ;;;; Speed commands
  1041. (make-obsolete-variable 'org-speed-commands-user
  1042. "configure `org-speed-commands' instead." "9.5")
  1043. (provide 'org-compat)
  1044. ;; Local variables:
  1045. ;; generated-autoload-file: "org-loaddefs.el"
  1046. ;; End:
  1047. ;;; org-compat.el ends here