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