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