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