org-compat.el 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324
  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. ;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-'
  28. ;; prefix, `find-tag' is replaced with `xref-find-definition' and
  29. ;; `x-get-selection' with `gui-get-selection'.
  30. (when (< emacs-major-version 25)
  31. (defalias 'outline-hide-entry 'hide-entry)
  32. (defalias 'outline-hide-sublevels 'hide-sublevels)
  33. (defalias 'outline-hide-subtree 'hide-subtree)
  34. (defalias 'outline-show-all 'show-all)
  35. (defalias 'outline-show-branches 'show-branches)
  36. (defalias 'outline-show-children 'show-children)
  37. (defalias 'outline-show-entry 'show-entry)
  38. (defalias 'outline-show-subtree 'show-subtree)
  39. (defalias 'xref-find-definitions 'find-tag)
  40. (defalias 'format-message 'format))
  41. (eval-when-compile
  42. (when (< emacs-major-version 25)
  43. (defalias 'gui-get-selection 'x-get-selection)))
  44. ;;; Obsolete aliases
  45. (define-obsolete-function-alias 'org-activate-mark 'activate-mark)
  46. ;;;; XEmacs compatibility, now removed.
  47. (define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0")
  48. (define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0")
  49. (define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0")
  50. (define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0")
  51. (define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0")
  52. (define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0")
  53. (define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0")
  54. (define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0")
  55. (define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0")
  56. (define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0")
  57. (define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0")
  58. (define-obsolete-function-alias 'org-match-string-no-properties 'match-string-properties "Org 9.0")
  59. (define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0")
  60. (define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0")
  61. (defmacro org-re (s)
  62. "Replace posix classes in regular expression."
  63. (declare (debug (form)))
  64. s)
  65. (make-obsolete 'org-re "It is now a no-op. You can safely remove it."
  66. "Org 9.0")
  67. ;;;; Functions from cl-lib that Org used to have its own implementation of.
  68. (define-obsolete-function-alias 'org-count 'cl-count "Org 9.0")
  69. (define-obsolete-function-alias 'org-every 'cl-every "Org 9.0")
  70. (define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0")
  71. (define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0")
  72. (define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0")
  73. (define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0")
  74. (define-obsolete-function-alias 'org-some 'cl-some "Org 9.0")
  75. (define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0")
  76. ;;;; Functions available since Emacs 24.3
  77. (define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0")
  78. (define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0")
  79. (define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0")
  80. (define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0")
  81. (define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0")
  82. (define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0")
  83. ;;;; Variables declared obsolete.
  84. (define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
  85. 'org-checkbox-hierarchical-statistics "Org 8.0")
  86. (define-obsolete-variable-alias 'org-description-max-indent
  87. 'org-list-description-max-indent "Org 8.0")
  88. (defun org-compatible-face (inherits specs)
  89. "Make a compatible face specification.
  90. If INHERITS is an existing face and if the Emacs version supports it,
  91. just inherit the face. If INHERITS is set and the Emacs version does
  92. not support it, copy the face specification from the inheritance face.
  93. If INHERITS is not given and SPECS is, use SPECS to define the face."
  94. (when (and inherits (facep inherits) (not specs))
  95. (setq specs (or specs
  96. (get inherits 'saved-face)
  97. (get inherits 'face-defface-spec))))
  98. (cond
  99. ((and inherits (facep inherits)
  100. (>= emacs-major-version 22)
  101. ;; do not inherit outline faces before Emacs 23
  102. (or (>= emacs-major-version 23)
  103. (not (string-match "\\`outline-[0-9]+"
  104. (symbol-name inherits)))))
  105. (list (list t :inherit inherits)))
  106. ((< emacs-major-version 22)
  107. ;; These do not understand the `min-colors' attribute.
  108. (let (r e a)
  109. (while (setq e (pop specs))
  110. (cond
  111. ((memq (car e) '(t default)) (push e r))
  112. ((setq a (member '(min-colors 8) (car e)))
  113. (nconc r (list (cons (cons '(type tty) (delq (car a) (car e)))
  114. (cdr e)))))
  115. ((setq a (assq 'min-colors (car e)))
  116. (setq e (cons (delq a (car e)) (cdr e)))
  117. (or (assoc (car e) r) (push e r)))
  118. (t (or (assoc (car e) r) (push e r)))))
  119. (nreverse r)))
  120. (t specs)))
  121. (put 'org-compatible-face 'lisp-indent-function 1)
  122. (defun org-version-check (version feature level)
  123. (let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
  124. (v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
  125. (rmaj (or (nth 0 v1) 99))
  126. (rmin (or (nth 1 v1) 99))
  127. (rbld (or (nth 2 v1) 99))
  128. (maj (or (nth 0 v2) 0))
  129. (min (or (nth 1 v2) 0))
  130. (bld (or (nth 2 v2) 0)))
  131. (if (or (< maj rmaj)
  132. (and (= maj rmaj)
  133. (< min rmin))
  134. (and (= maj rmaj)
  135. (= min rmin)
  136. (< bld rbld)))
  137. (if (eq level :predicate)
  138. ;; just return if we have the version
  139. nil
  140. (let ((msg (format "Emacs %s or greater is recommended for %s"
  141. version feature)))
  142. (display-warning 'org msg level)
  143. t))
  144. t)))
  145. ;;; Miscellaneous functions
  146. (defun org-get-x-clipboard (value)
  147. "Get the value of the X or Windows clipboard."
  148. (cond ((eq window-system 'x)
  149. (org-no-properties
  150. (ignore-errors
  151. (or (gui-get-selection value 'UTF8_STRING)
  152. (gui-get-selection value 'COMPOUND_TEXT)
  153. (gui-get-selection value 'STRING)
  154. (gui-get-selection value 'TEXT)))))
  155. ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
  156. (w32-get-clipboard-data))))
  157. (defun org-add-props (string plist &rest props)
  158. "Add text properties to entire string, from beginning to end.
  159. PLIST may be a list of properties, PROPS are individual properties and values
  160. that will be added to PLIST. Returns the string that was modified."
  161. (add-text-properties
  162. 0 (length string) (if props (append plist props) plist) string)
  163. string)
  164. (put 'org-add-props 'lisp-indent-function 2)
  165. (defun org-fit-window-to-buffer (&optional window max-height min-height
  166. shrink-only)
  167. "Fit WINDOW to the buffer, but only if it is not a side-by-side window.
  168. WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are
  169. passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call
  170. `shrink-window-if-larger-than-buffer' instead, the height limit is
  171. ignored in this case."
  172. (cond ((if (fboundp 'window-full-width-p)
  173. (not (window-full-width-p window))
  174. ;; do nothing if another window would suffer
  175. (> (frame-width) (window-width window))))
  176. ((and (fboundp 'fit-window-to-buffer) (not shrink-only))
  177. (fit-window-to-buffer window max-height min-height))
  178. ((fboundp 'shrink-window-if-larger-than-buffer)
  179. (shrink-window-if-larger-than-buffer window)))
  180. (or window (selected-window)))
  181. ;; `set-transient-map' is only in Emacs >= 24.4
  182. (defalias 'org-set-transient-map
  183. (if (fboundp 'set-transient-map)
  184. 'set-transient-map
  185. 'set-temporary-overlay-map))
  186. ;;; Region compatibility
  187. (defvar org-ignore-region nil
  188. "Non-nil means temporarily disable the active region.")
  189. (defun org-region-active-p ()
  190. "Is `transient-mark-mode' on and the region active?"
  191. (if org-ignore-region
  192. nil
  193. (if (fboundp 'use-region-p)
  194. (use-region-p)
  195. (and transient-mark-mode mark-active)))) ; Emacs 22 and before
  196. (defun org-cursor-to-region-beginning ()
  197. (when (and (org-region-active-p)
  198. (> (point) (region-beginning)))
  199. (exchange-point-and-mark)))
  200. ;;; Invisibility compatibility
  201. (defun org-remove-from-invisibility-spec (arg)
  202. "Remove elements from `buffer-invisibility-spec'."
  203. (if (fboundp 'remove-from-invisibility-spec)
  204. (remove-from-invisibility-spec arg)
  205. (if (consp buffer-invisibility-spec)
  206. (setq buffer-invisibility-spec
  207. (delete arg buffer-invisibility-spec)))))
  208. (defun org-in-invisibility-spec-p (arg)
  209. "Is ARG a member of `buffer-invisibility-spec'?"
  210. (if (consp buffer-invisibility-spec)
  211. (member arg buffer-invisibility-spec)))
  212. (defun org-move-to-column (column &optional force _buffer)
  213. "Move to column COLUMN.
  214. Pass COLUMN and FORCE to `move-to-column'."
  215. (let ((buffer-invisibility-spec
  216. (if (listp buffer-invisibility-spec)
  217. (remove '(org-filtered) buffer-invisibility-spec)
  218. buffer-invisibility-spec)))
  219. (move-to-column column force)))
  220. (defmacro org-find-library-dir (library)
  221. `(file-name-directory (or (locate-library ,library) "")))
  222. (defun org-count-lines (s)
  223. "How many lines in string S?"
  224. (let ((start 0) (n 1))
  225. (while (string-match "\n" s start)
  226. (setq start (match-end 0) n (1+ n)))
  227. (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
  228. (setq n (1- n)))
  229. n))
  230. (defun org-kill-new (string &rest args)
  231. (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
  232. string)
  233. (apply 'kill-new string args))
  234. ;; `font-lock-ensure' is only available from 24.4.50 on
  235. (defalias 'org-font-lock-ensure
  236. (if (fboundp 'font-lock-ensure)
  237. #'font-lock-ensure
  238. (lambda (&optional _beg _end)
  239. (with-no-warnings (font-lock-fontify-buffer)))))
  240. (defmacro org-no-popups (&rest body)
  241. "Suppress popup windows.
  242. Let-bind some variables to nil around BODY to achieve the desired
  243. effect, which variables to use depends on the Emacs version."
  244. (if (org-version-check "24.2.50" "" :predicate)
  245. `(let (pop-up-frames display-buffer-alist)
  246. ,@body)
  247. `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
  248. ,@body)))
  249. ;;;###autoload
  250. (defmacro org-check-version ()
  251. "Try very hard to provide sensible version strings."
  252. (let* ((org-dir (org-find-library-dir "org"))
  253. (org-version.el (concat org-dir "org-version.el"))
  254. (org-fixup.el (concat org-dir "../mk/org-fixup.el")))
  255. (if (require 'org-version org-version.el 'noerror)
  256. '(progn
  257. (autoload 'org-release "org-version.el")
  258. (autoload 'org-git-version "org-version.el"))
  259. (if (require 'org-fixup org-fixup.el 'noerror)
  260. '(org-fixup)
  261. ;; provide fallback definitions and complain
  262. (warn "Could not define org version correctly. Check installation!")
  263. '(progn
  264. (defun org-release () "N/A")
  265. (defun org-git-version () "N/A !!check installation!!"))))))
  266. (defmacro org-with-silent-modifications (&rest body)
  267. (if (fboundp 'with-silent-modifications)
  268. `(with-silent-modifications ,@body)
  269. `(org-unmodified ,@body)))
  270. (def-edebug-spec org-with-silent-modifications (body))
  271. ;; Remove this when support for Emacs < 24.4 is dropped.
  272. (defun org-define-error (name message)
  273. "Define NAME as a new error signal.
  274. MESSAGE is a string that will be output to the echo area if such
  275. an error is signaled without being caught by a `condition-case'.
  276. Implements `define-error' for older emacsen."
  277. (if (fboundp 'define-error) (define-error name message)
  278. (put name 'error-conditions
  279. (copy-sequence (cons name (get 'error 'error-conditions))))))
  280. (provide 'org-compat)
  281. ;;; org-compat.el ends here