org-compat.el 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454
  1. ;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
  3. ;; Author: Carsten Dominik <carsten at orgmode dot org>
  4. ;; Keywords: outlines, hypermedia, calendar, wp
  5. ;; Homepage: http://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 <http://www.gnu.org/licenses/>.
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. ;;
  21. ;;; Commentary:
  22. ;; This file contains code needed for compatibility with older
  23. ;; versions of GNU Emacs.
  24. ;;; Code:
  25. (require 'cl-lib)
  26. (require 'org-macs)
  27. (declare-function org-link-set-parameters "org" (type &rest rest))
  28. ;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-'
  29. ;; prefix, `find-tag' is replaced with `xref-find-definition' and
  30. ;; `x-get-selection' with `gui-get-selection'.
  31. (when (< emacs-major-version 25)
  32. (defalias 'outline-hide-entry 'hide-entry)
  33. (defalias 'outline-hide-sublevels 'hide-sublevels)
  34. (defalias 'outline-hide-subtree 'hide-subtree)
  35. (defalias 'outline-show-all 'show-all)
  36. (defalias 'outline-show-branches 'show-branches)
  37. (defalias 'outline-show-children 'show-children)
  38. (defalias 'outline-show-entry 'show-entry)
  39. (defalias 'outline-show-subtree 'show-subtree)
  40. (defalias 'xref-find-definitions 'find-tag)
  41. (defalias 'format-message 'format)
  42. (defalias 'gui-get-selection 'x-get-selection))
  43. ;;; Obsolete aliases (remove them once the next major release is released).
  44. ;;;; XEmacs compatibility, now removed.
  45. (define-obsolete-function-alias 'org-activate-mark 'activate-mark)
  46. (define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0")
  47. (define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0")
  48. (define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0")
  49. (define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0")
  50. (define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0")
  51. (define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0")
  52. (define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0")
  53. (define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0")
  54. (define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0")
  55. (define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0")
  56. (define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0")
  57. (define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0")
  58. (define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0")
  59. (define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0")
  60. (defmacro org-re (s)
  61. "Replace posix classes in regular expression S."
  62. (declare (debug (form))
  63. (obsolete "you can safely remove it." "Org 9.0"))
  64. s)
  65. ;;;; Functions from cl-lib that Org used to have its own implementation of.
  66. (define-obsolete-function-alias 'org-count 'cl-count "Org 9.0")
  67. (define-obsolete-function-alias 'org-every 'cl-every "Org 9.0")
  68. (define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0")
  69. (define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0")
  70. (define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0")
  71. (define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0")
  72. (define-obsolete-function-alias 'org-some 'cl-some "Org 9.0")
  73. (define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0")
  74. ;;;; Functions available since Emacs 24.3
  75. (define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0")
  76. (define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "Org 9.0")
  77. (define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0")
  78. (define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0")
  79. (define-obsolete-function-alias 'org-format-seconds 'format-seconds "Org 9.0")
  80. (define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "Org 9.0")
  81. (define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "Org 9.0")
  82. (define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0")
  83. (define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0")
  84. (define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0")
  85. ;;;; Functions and variables from previous releases now obsolete.
  86. (define-obsolete-function-alias 'org-element-remove-indentation
  87. 'org-remove-indentation "Org 9.0")
  88. (define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
  89. 'org-checkbox-hierarchical-statistics "Org 8.0")
  90. (define-obsolete-variable-alias 'org-description-max-indent
  91. 'org-list-description-max-indent "Org 8.0")
  92. (define-obsolete-variable-alias 'org-latex-create-formula-image-program
  93. 'org-preview-latex-default-process "Org 9.0")
  94. (define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
  95. 'org-preview-latex-image-directory "Org 9.0")
  96. (define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0")
  97. (define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0")
  98. (define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3")
  99. (define-obsolete-function-alias 'org-speed-command-default-hook
  100. 'org-speed-command-activate "Org 8.0")
  101. (define-obsolete-function-alias 'org-babel-speed-command-hook
  102. 'org-babel-speed-command-activate "Org 8.0")
  103. (define-obsolete-function-alias 'org-image-file-name-regexp
  104. 'image-file-name-regexp "Org 9.0")
  105. (define-obsolete-function-alias 'org-get-legal-level
  106. 'org-get-valid-level "Org 7.8")
  107. (define-obsolete-function-alias 'org-completing-read-no-i
  108. 'completing-read "Org 9.0")
  109. (define-obsolete-function-alias 'org-icompleting-read
  110. 'completing-read "Org 9.0")
  111. (define-obsolete-function-alias 'org-iread-file-name 'read-file-name "Org 9.0")
  112. (define-obsolete-function-alias 'org-days-to-time
  113. 'org-time-stamp-to-now "Org 8.2")
  114. (define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties
  115. 'org-agenda-ignore-properties "Org 9.0")
  116. (define-obsolete-function-alias 'org-preview-latex-fragment
  117. 'org-toggle-latex-fragment "Org 8.3")
  118. (define-obsolete-function-alias 'org-display-inline-modification-hook
  119. 'org-display-inline-remove-overlay "Org 8.0")
  120. (define-obsolete-function-alias 'org-export-get-genealogy
  121. 'org-element-lineage "Org 9.0")
  122. (define-obsolete-variable-alias 'org-latex-with-hyperref
  123. 'org-latex-hyperref-template "Org 9.0")
  124. (define-obsolete-variable-alias 'org-link-to-org-use-id
  125. 'org-id-link-to-org-use-id "Org 8.0")
  126. (define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0")
  127. (define-obsolete-variable-alias 'org-clock-modeline-total
  128. 'org-clock-mode-line-total "Org 8.0")
  129. (define-obsolete-function-alias 'org-protocol-unhex-compound
  130. 'org-link-unescape-compound "Org 7.8")
  131. (define-obsolete-function-alias 'org-protocol-unhex-string
  132. 'org-link-unescape "Org 7.8")
  133. (define-obsolete-function-alias 'org-protocol-unhex-single-byte-sequence
  134. 'org-link-unescape-single-byte-sequence "Org 7.8")
  135. (define-obsolete-variable-alias 'org-export-htmlized-org-css-url
  136. 'org-org-htmlized-css-url "Org 8.2")
  137. (define-obsolete-variable-alias 'org-alphabetical-lists
  138. 'org-list-allow-alphabetical "Org 8.0")
  139. (define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0")
  140. (define-obsolete-variable-alias 'org-agenda-menu-two-column
  141. 'org-agenda-menu-two-columns "Org 8.0")
  142. (define-obsolete-variable-alias 'org-finalize-agenda-hook
  143. 'org-agenda-finalize-hook "Org 8.0")
  144. (make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "Org 7.8")
  145. (define-obsolete-function-alias 'org-agenda-post-command-hook
  146. 'org-agenda-update-agenda-type "Org 8.0")
  147. (define-obsolete-function-alias 'org-agenda-todayp
  148. 'org-agenda-today-p "Org 9.0")
  149. (define-obsolete-function-alias 'org-babel-examplize-region
  150. 'org-babel-examplify-region "Org 9.0")
  151. (define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0")
  152. (define-obsolete-variable-alias 'org-html-style-include-scripts
  153. 'org-html-head-include-scripts "Org 8.0")
  154. (define-obsolete-variable-alias 'org-html-style-include-default
  155. 'org-html-head-include-default-style "Org 8.0")
  156. (define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
  157. (define-obsolete-function-alias 'org-insert-columns-dblock
  158. 'org-columns-insert-dblock "Org 9.0")
  159. (defcustom org-read-date-minibuffer-setup-hook nil
  160. "Hook to be used to set up keys for the date/time interface.
  161. Add key definitions to `minibuffer-local-map', which will be a
  162. temporary copy."
  163. :group 'org-time
  164. :type 'hook)
  165. (make-obsolete-variable
  166. 'org-read-date-minibuffer-setup-hook
  167. "set `org-read-date-minibuffer-local-map' instead." "Org 8.0")
  168. (defun org-compatible-face (inherits specs)
  169. "Make a compatible face specification.
  170. If INHERITS is an existing face and if the Emacs version supports
  171. it, just inherit the face. If INHERITS is not given and SPECS
  172. is, use SPECS to define the face."
  173. (declare (indent 1))
  174. (if (facep inherits)
  175. (list (list t :inherit inherits))
  176. specs))
  177. (make-obsolete 'org-compatible-face "you can remove it." "Org 9.0")
  178. (defun org-add-link-type (type &optional follow export)
  179. "Add a new TYPE link.
  180. FOLLOW and EXPORT are two functions.
  181. FOLLOW should take the link path as the single argument and do whatever
  182. is necessary to follow the link, for example find a file or display
  183. a mail message.
  184. EXPORT should format the link path for export to one of the export formats.
  185. It should be a function accepting three arguments:
  186. path the path of the link, the text after the prefix (like \"http:\")
  187. desc the description of the link, if any
  188. format the export format, a symbol like `html' or `latex' or `ascii'.
  189. The function may use the FORMAT information to return different values
  190. depending on the format. The return value will be put literally into
  191. the exported file. If the return value is nil, this means Org should
  192. do what it normally does with links which do not have EXPORT defined.
  193. Org mode has a built-in default for exporting links. If you are happy with
  194. this default, there is no need to define an export function for the link
  195. type. For a simple example of an export function, see `org-bbdb.el'.
  196. If TYPE already exists, update it with the arguments.
  197. See `org-link-parameters' for documentation on the other parameters."
  198. (org-link-set-parameters type :follow follow :export export)
  199. (message "Created %s link." type))
  200. (make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0")
  201. ;;;; Obsolete link types
  202. (eval-after-load 'org
  203. '(progn
  204. (org-link-set-parameters "file+emacs") ;since Org 9.0
  205. (org-link-set-parameters "file+sys"))) ;since Org 9.0
  206. ;;; Miscellaneous functions
  207. (defun org-version-check (version feature level)
  208. (let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
  209. (v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
  210. (rmaj (or (nth 0 v1) 99))
  211. (rmin (or (nth 1 v1) 99))
  212. (rbld (or (nth 2 v1) 99))
  213. (maj (or (nth 0 v2) 0))
  214. (min (or (nth 1 v2) 0))
  215. (bld (or (nth 2 v2) 0)))
  216. (if (or (< maj rmaj)
  217. (and (= maj rmaj)
  218. (< min rmin))
  219. (and (= maj rmaj)
  220. (= min rmin)
  221. (< bld rbld)))
  222. (if (eq level :predicate)
  223. ;; just return if we have the version
  224. nil
  225. (let ((msg (format "Emacs %s or greater is recommended for %s"
  226. version feature)))
  227. (display-warning 'org msg level)
  228. t))
  229. t)))
  230. (defun org-get-x-clipboard (value)
  231. "Get the value of the X or Windows clipboard."
  232. (cond ((eq window-system 'x)
  233. (org-no-properties
  234. (ignore-errors
  235. (or (gui-get-selection value 'UTF8_STRING)
  236. (gui-get-selection value 'COMPOUND_TEXT)
  237. (gui-get-selection value 'STRING)
  238. (gui-get-selection value 'TEXT)))))
  239. ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
  240. (w32-get-clipboard-data))))
  241. (defun org-add-props (string plist &rest props)
  242. "Add text properties to entire string, from beginning to end.
  243. PLIST may be a list of properties, PROPS are individual properties and values
  244. that will be added to PLIST. Returns the string that was modified."
  245. (add-text-properties
  246. 0 (length string) (if props (append plist props) plist) string)
  247. string)
  248. (put 'org-add-props 'lisp-indent-function 2)
  249. (defun org-fit-window-to-buffer (&optional window max-height min-height
  250. shrink-only)
  251. "Fit WINDOW to the buffer, but only if it is not a side-by-side window.
  252. WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are
  253. passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call
  254. `shrink-window-if-larger-than-buffer' instead, the height limit is
  255. ignored in this case."
  256. (cond ((if (fboundp 'window-full-width-p)
  257. (not (window-full-width-p window))
  258. ;; do nothing if another window would suffer
  259. (> (frame-width) (window-width window))))
  260. ((and (fboundp 'fit-window-to-buffer) (not shrink-only))
  261. (fit-window-to-buffer window max-height min-height))
  262. ((fboundp 'shrink-window-if-larger-than-buffer)
  263. (shrink-window-if-larger-than-buffer window)))
  264. (or window (selected-window)))
  265. ;; `set-transient-map' is only in Emacs >= 24.4
  266. (defalias 'org-set-transient-map
  267. (if (fboundp 'set-transient-map)
  268. 'set-transient-map
  269. 'set-temporary-overlay-map))
  270. ;;; Region compatibility
  271. (defvar org-ignore-region nil
  272. "Non-nil means temporarily disable the active region.")
  273. (defun org-region-active-p ()
  274. "Non-nil when the region active.
  275. Unlike to `use-region-p', this function also checks
  276. `org-ignore-region'."
  277. (and (not org-ignore-region) (use-region-p)))
  278. (defun org-cursor-to-region-beginning ()
  279. (when (and (org-region-active-p)
  280. (> (point) (region-beginning)))
  281. (exchange-point-and-mark)))
  282. ;;; Invisibility compatibility
  283. (defun org-remove-from-invisibility-spec (arg)
  284. "Remove elements from `buffer-invisibility-spec'."
  285. (if (fboundp 'remove-from-invisibility-spec)
  286. (remove-from-invisibility-spec arg)
  287. (if (consp buffer-invisibility-spec)
  288. (setq buffer-invisibility-spec
  289. (delete arg buffer-invisibility-spec)))))
  290. (defun org-in-invisibility-spec-p (arg)
  291. "Is ARG a member of `buffer-invisibility-spec'?"
  292. (if (consp buffer-invisibility-spec)
  293. (member arg buffer-invisibility-spec)))
  294. (defun org-move-to-column (column &optional force _buffer)
  295. "Move to column COLUMN.
  296. Pass COLUMN and FORCE to `move-to-column'."
  297. (let ((buffer-invisibility-spec
  298. (if (listp buffer-invisibility-spec)
  299. (remove '(org-filtered) buffer-invisibility-spec)
  300. buffer-invisibility-spec)))
  301. (move-to-column column force)))
  302. (defmacro org-find-library-dir (library)
  303. `(file-name-directory (or (locate-library ,library) "")))
  304. (defun org-count-lines (s)
  305. "How many lines in string S?"
  306. (let ((start 0) (n 1))
  307. (while (string-match "\n" s start)
  308. (setq start (match-end 0) n (1+ n)))
  309. (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
  310. (setq n (1- n)))
  311. n))
  312. (defun org-kill-new (string &rest args)
  313. (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
  314. string)
  315. (apply 'kill-new string args))
  316. ;; `font-lock-ensure' is only available from 24.4.50 on
  317. (defalias 'org-font-lock-ensure
  318. (if (fboundp 'font-lock-ensure)
  319. #'font-lock-ensure
  320. (lambda (&optional _beg _end)
  321. (with-no-warnings (font-lock-fontify-buffer)))))
  322. (defmacro org-no-popups (&rest body)
  323. "Suppress popup windows.
  324. Let-bind some variables to nil around BODY to achieve the desired
  325. effect, which variables to use depends on the Emacs version."
  326. (if (org-version-check "24.2.50" "" :predicate)
  327. `(let (pop-up-frames display-buffer-alist)
  328. ,@body)
  329. `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
  330. ,@body)))
  331. ;;;###autoload
  332. (defmacro org-check-version ()
  333. "Try very hard to provide sensible version strings."
  334. (let* ((org-dir (org-find-library-dir "org"))
  335. (org-version.el (concat org-dir "org-version.el"))
  336. (org-fixup.el (concat org-dir "../mk/org-fixup.el")))
  337. (if (require 'org-version org-version.el 'noerror)
  338. '(progn
  339. (autoload 'org-release "org-version.el")
  340. (autoload 'org-git-version "org-version.el"))
  341. (if (require 'org-fixup org-fixup.el 'noerror)
  342. '(org-fixup)
  343. ;; provide fallback definitions and complain
  344. (warn "Could not define org version correctly. Check installation!")
  345. '(progn
  346. (defun org-release () "N/A")
  347. (defun org-git-version () "N/A !!check installation!!"))))))
  348. (defmacro org-with-silent-modifications (&rest body)
  349. (if (fboundp 'with-silent-modifications)
  350. `(with-silent-modifications ,@body)
  351. `(org-unmodified ,@body)))
  352. (def-edebug-spec org-with-silent-modifications (body))
  353. ;; Functions for Emacs < 24.4 compatibility
  354. (defun org-define-error (name message)
  355. "Define NAME as a new error signal.
  356. MESSAGE is a string that will be output to the echo area if such
  357. an error is signaled without being caught by a `condition-case'.
  358. Implements `define-error' for older emacsen."
  359. (if (fboundp 'define-error) (define-error name message)
  360. (put name 'error-conditions
  361. (copy-sequence (cons name (get 'error 'error-conditions))))))
  362. (unless (fboundp 'string-suffix-p)
  363. ;; From Emacs subr.el.
  364. (defun string-prefix-p (prefix string &optional ignore-case)
  365. "Return non-nil if PREFIX is a prefix of STRING.
  366. If IGNORE-CASE is non-nil, the comparison is done without paying attention
  367. to case differences."
  368. (let ((prefix-length (length prefix)))
  369. (if (> prefix-length (length string)) nil
  370. (eq t (compare-strings prefix 0 prefix-length string
  371. 0 prefix-length ignore-case)))))
  372. (defun string-suffix-p (suffix string &optional ignore-case)
  373. "Return non-nil if SUFFIX is a suffix of STRING.
  374. If IGNORE-CASE is non-nil, the comparison is done without paying
  375. attention to case differences."
  376. (let ((start-pos (- (length string) (length suffix))))
  377. (and (>= start-pos 0)
  378. (eq t (compare-strings suffix nil nil
  379. string start-pos nil ignore-case)))))
  380. (defsubst string-blank-p (string)
  381. "Check whether STRING is either empty or only whitespace."
  382. (string-match-p "\\`[ \t\n\r]*\\'" string))
  383. (defsubst string-remove-prefix (prefix string)
  384. "Remove PREFIX from STRING if present."
  385. (if (string-prefix-p prefix string)
  386. (substring string (length prefix))
  387. string))
  388. (defsubst string-remove-suffix (suffix string)
  389. "Remove SUFFIX from STRING if present."
  390. (if (string-suffix-p suffix string)
  391. (substring string 0 (- (length string) (length suffix)))
  392. string)))
  393. (provide 'org-compat)
  394. ;;; org-compat.el ends here