lisp/org-compat.el

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