lisp/org-compat.el

   1 ;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2004-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   6 ;; Keywords: outlines, hypermedia, calendar, wp
   7 ;; Homepage: https://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 <https://www.gnu.org/licenses/>.
  23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24 ;;
  25 ;;; Commentary:
  26
  27 ;; This file contains code needed for compatibility with older
  28 ;; versions of GNU Emacs and integration with other packages.
  29
  30 ;;; Code:
  31
  32 (require 'cl-lib)
  33 (require 'org-macs)
  34
  35 (declare-function org-agenda-diary-entry "org-agenda")
  36 (declare-function org-agenda-maybe-redo "org-agenda" ())
  37 (declare-function org-at-heading-p "org" (&optional ignored))
  38 (declare-function org-at-table.el-p "org" ())
  39 (declare-function org-element-at-point "org-element" ())
  40 (declare-function org-element-context "org-element" (&optional element))
  41 (declare-function org-element-lineage "org-element" (blob &optional types with-self))
  42 (declare-function org-element-type "org-element" (element))
  43 (declare-function org-element-property "org-element" (property element))
  44 (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
  45 (declare-function org-invisible-p "org" (&optional pos))
  46 (declare-function org-link-display-format "org" (s))
  47 (declare-function org-link-set-parameters "org" (type &rest rest))
  48 (declare-function org-log-into-drawer "org" ())
  49 (declare-function org-reduced-level "org" (l))
  50 (declare-function org-show-context "org" (&optional key))
  51 (declare-function org-table-end "org-table" (&optional table-type))
  52 (declare-function outline-next-heading "outline" ())
  53 (declare-function speedbar-line-directory "speedbar" (&optional depth))
  54 (declare-function table--at-cell-p "table" (position &optional object at-column))
  55
  56 (defvar calendar-mode-map)
  57 (defvar org-complex-heading-regexp)
  58 (defvar org-agenda-diary-file)
  59 (defvar org-table-any-border-regexp)
  60 (defvar org-table-dataline-regexp)
  61 (defvar org-table-tab-recognizes-table.el)
  62 (defvar org-table1-hline-regexp)
  63
  64 \f
  65 ;;; Emacs < 25.1 compatibility
  66
  67 (when (< emacs-major-version 25)
  68   (defalias 'outline-hide-entry 'hide-entry)
  69   (defalias 'outline-hide-sublevels 'hide-sublevels)
  70   (defalias 'outline-hide-subtree 'hide-subtree)
  71   (defalias 'outline-show-branches 'show-branches)
  72   (defalias 'outline-show-children 'show-children)
  73   (defalias 'outline-show-entry 'show-entry)
  74   (defalias 'outline-show-subtree 'show-subtree)
  75   (defalias 'xref-find-definitions 'find-tag)
  76   (defalias 'format-message 'format)
  77   (defalias 'gui-get-selection 'x-get-selection))
  78
  79 (unless (fboundp 'directory-name-p)
  80   (defun directory-name-p (name)
  81     "Return non-nil if NAME ends with a directory separator character."
  82     (let ((len (length name))
  83           (lastc ?.))
  84       (if (> len 0)
  85           (setq lastc (aref name (1- len))))
  86       (or (= lastc ?/)
  87           (and (memq system-type '(windows-nt ms-dos))
  88                (= lastc ?\\))))))
  89
  90 (unless (fboundp 'directory-files-recursively)
  91   (defun directory-files-recursively (dir regexp &optional include-directories)
  92     "Return list of all files under DIR that have file names matching REGEXP.
  93 This function works recursively.  Files are returned in \"depth first\"
  94 order, and files from each directory are sorted in alphabetical order.
  95 Each file name appears in the returned list in its absolute form.
  96 Optional argument INCLUDE-DIRECTORIES non-nil means also include in the
  97 output directories whose names match REGEXP."
  98     (let ((result nil)
  99           (files nil)
 100           ;; When DIR is "/", remote file names like "/method:" could
 101           ;; also be offered.  We shall suppress them.
 102           (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
 103       (dolist (file (sort (file-name-all-completions "" dir)
 104                           'string<))
 105         (unless (member file '("./" "../"))
 106           (if (directory-name-p file)
 107               (let* ((leaf (substring file 0 (1- (length file))))
 108                      (full-file (expand-file-name leaf dir)))
 109                 ;; Don't follow symlinks to other directories.
 110                 (unless (file-symlink-p full-file)
 111                   (setq result
 112                         (nconc result (directory-files-recursively
 113                                        full-file regexp include-directories))))
 114                 (when (and include-directories
 115                            (string-match regexp leaf))
 116                   (setq result (nconc result (list full-file)))))
 117             (when (string-match regexp file)
 118               (push (expand-file-name file dir) files)))))
 119       (nconc result (nreverse files)))))
 120
 121 \f
 122 ;;; Obsolete aliases (remove them after the next major release).
 123
 124 ;;;; XEmacs compatibility, now removed.
 125 (define-obsolete-function-alias 'org-activate-mark 'activate-mark)
 126 (define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0")
 127 (define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0")
 128 (define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0")
 129 (define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0")
 130 (define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0")
 131 (define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0")
 132 (define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0")
 133 (define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0")
 134 (define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0")
 135 (define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0")
 136 (define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0")
 137 (define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0")
 138 (define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0")
 139 (define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0")
 140
 141 (defmacro org-re (s)
 142   "Replace posix classes in regular expression S."
 143   (declare (debug (form))
 144            (obsolete "you can safely remove it." "Org 9.0"))
 145   s)
 146
 147 ;;;; Functions from cl-lib that Org used to have its own implementation of.
 148 (define-obsolete-function-alias 'org-count 'cl-count "Org 9.0")
 149 (define-obsolete-function-alias 'org-every 'cl-every "Org 9.0")
 150 (define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0")
 151 (define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0")
 152 (define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0")
 153 (define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0")
 154 (define-obsolete-function-alias 'org-some 'cl-some "Org 9.0")
 155 (define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0")
 156
 157 (defun org-sublist (list start end)
 158   "Return a section of LIST, from START to END.
 159 Counting starts at 1."
 160   (cl-subseq list (1- start) end))
 161 (make-obsolete 'org-sublist
 162                "use cl-subseq (note the 0-based counting)."
 163                "Org 9.0")
 164
 165
 166 ;;;; Functions available since Emacs 24.3
 167 (define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0")
 168 (define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "Org 9.0")
 169 (define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0")
 170 (define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0")
 171 (define-obsolete-function-alias 'org-format-seconds 'format-seconds "Org 9.0")
 172 (define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "Org 9.0")
 173 (define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "Org 9.0")
 174 (define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0")
 175 (define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0")
 176 (define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0")
 177
 178 ;;;; Functions and variables from previous releases now obsolete.
 179 (define-obsolete-function-alias 'org-element-remove-indentation
 180   'org-remove-indentation "Org 9.0")
 181 (define-obsolete-variable-alias 'org-latex-create-formula-image-program
 182   'org-preview-latex-default-process "Org 9.0")
 183 (define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
 184   'org-preview-latex-image-directory "Org 9.0")
 185 (define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0")
 186 (define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0")
 187 (define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3")
 188 (define-obsolete-function-alias 'org-image-file-name-regexp
 189   'image-file-name-regexp "Org 9.0")
 190 (define-obsolete-function-alias 'org-completing-read-no-i
 191   'completing-read "Org 9.0")
 192 (define-obsolete-function-alias 'org-icompleting-read
 193   'completing-read "Org 9.0")
 194 (define-obsolete-function-alias 'org-iread-file-name 'read-file-name "Org 9.0")
 195 (define-obsolete-function-alias 'org-days-to-time
 196   'org-time-stamp-to-now "Org 8.2")
 197 (define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties
 198   'org-agenda-ignore-properties "Org 9.0")
 199 (define-obsolete-function-alias 'org-preview-latex-fragment
 200   'org-toggle-latex-fragment "Org 8.3")
 201 (define-obsolete-function-alias 'org-export-get-genealogy
 202   'org-element-lineage "Org 9.0")
 203 (define-obsolete-variable-alias 'org-latex-with-hyperref
 204   'org-latex-hyperref-template "Org 9.0")
 205 (define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0")
 206 (define-obsolete-variable-alias 'org-export-htmlized-org-css-url
 207   'org-org-htmlized-css-url "Org 8.2")
 208 (define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0")
 209 (define-obsolete-function-alias 'org-agenda-todayp
 210   'org-agenda-today-p "Org 9.0")
 211 (define-obsolete-function-alias 'org-babel-examplize-region
 212   'org-babel-examplify-region "Org 9.0")
 213 (define-obsolete-variable-alias 'org-babel-capitalize-example-region-markers
 214   'org-babel-uppercase-example-markers "Org 9.1")
 215
 216 (define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0")
 217 (define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
 218 (define-obsolete-function-alias 'org-insert-columns-dblock
 219   'org-columns-insert-dblock "Org 9.0")
 220 (define-obsolete-variable-alias 'org-export-babel-evaluate
 221   'org-export-use-babel "Org 9.1")
 222 (define-obsolete-function-alias 'org-activate-bracket-links
 223   'org-activate-links "Org 9.0")
 224 (define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0")
 225 (define-obsolete-function-alias 'org-activate-angle-links 'ignore "Org 9.0")
 226
 227 (defun org-in-fixed-width-region-p ()
 228   "Non-nil if point in a fixed-width region."
 229   (save-match-data
 230     (eq 'fixed-width (org-element-type (org-element-at-point)))))
 231 (make-obsolete 'org-in-fixed-width-region-p
 232                "use `org-element' library"
 233                "Org 9.0")
 234
 235 (defun org-compatible-face (inherits specs)
 236   "Make a compatible face specification.
 237 If INHERITS is an existing face and if the Emacs version supports
 238 it, just inherit the face.  If INHERITS is not given and SPECS
 239 is, use SPECS to define the face."
 240   (declare (indent 1))
 241   (if (facep inherits)
 242       (list (list t :inherit inherits))
 243     specs))
 244 (make-obsolete 'org-compatible-face "you can remove it." "Org 9.0")
 245
 246 (defun org-add-link-type (type &optional follow export)
 247   "Add a new TYPE link.
 248 FOLLOW and EXPORT are two functions.
 249
 250 FOLLOW should take the link path as the single argument and do whatever
 251 is necessary to follow the link, for example find a file or display
 252 a mail message.
 253
 254 EXPORT should format the link path for export to one of the export formats.
 255 It should be a function accepting three arguments:
 256
 257   path    the path of the link, the text after the prefix (like \"http:\")
 258   desc    the description of the link, if any
 259   format  the export format, a symbol like `html' or `latex' or `ascii'.
 260
 261 The function may use the FORMAT information to return different values
 262 depending on the format.  The return value will be put literally into
 263 the exported file.  If the return value is nil, this means Org should
 264 do what it normally does with links which do not have EXPORT defined.
 265
 266 Org mode has a built-in default for exporting links.  If you are happy with
 267 this default, there is no need to define an export function for the link
 268 type.  For a simple example of an export function, see `org-bbdb.el'.
 269
 270 If TYPE already exists, update it with the arguments.
 271 See `org-link-parameters' for documentation on the other parameters."
 272   (org-link-set-parameters type :follow follow :export export)
 273   (message "Created %s link." type))
 274
 275 (make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0")
 276
 277 (defun org-table-recognize-table.el ()
 278   "If there is a table.el table nearby, recognize it and move into it."
 279   (when (and org-table-tab-recognizes-table.el (org-at-table.el-p))
 280     (beginning-of-line)
 281     (unless (or (looking-at org-table-dataline-regexp)
 282                 (not (looking-at org-table1-hline-regexp)))
 283       (forward-line)
 284       (when (looking-at org-table-any-border-regexp)
 285         (forward-line -2)))
 286     (if (re-search-forward "|" (org-table-end t) t)
 287         (progn
 288           (require 'table)
 289           (if (table--at-cell-p (point)) t
 290             (message "recognizing table.el table...")
 291             (table-recognize-table)
 292             (message "recognizing table.el table...done")))
 293       (error "This should not happen"))))
 294
 295 ;; Not used by Org core since commit 6d1e3082, Feb 2010.
 296 (make-obsolete 'org-table-recognize-table.el
 297                "please notify the org mailing list if you use this function."
 298                "Org 9.0")
 299
 300 (defun org-remove-angle-brackets (s)
 301   (org-unbracket-string "<" ">" s))
 302 (make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0")
 303
 304 (defun org-remove-double-quotes (s)
 305   (org-unbracket-string "\"" "\"" s))
 306 (make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0")
 307
 308 (defcustom org-publish-sitemap-file-entry-format "%t"
 309   "Format string for site-map file entry.
 310 You could use brackets to delimit on what part the link will be.
 311
 312 %t is the title.
 313 %a is the author.
 314 %d is the date formatted using `org-publish-sitemap-date-format'."
 315   :group 'org-export-publish
 316   :type 'string)
 317 (make-obsolete-variable
 318  'org-publish-sitemap-file-entry-format
 319  "set `:sitemap-format-entry' in `org-publish-project-alist' instead."
 320  "Org 9.1")
 321
 322 (defvar org-agenda-skip-regexp)
 323 (defun org-agenda-skip-entry-when-regexp-matches ()
 324   "Check if the current entry contains match for `org-agenda-skip-regexp'.
 325 If yes, it returns the end position of this entry, causing agenda commands
 326 to skip the entry but continuing the search in the subtree.  This is a
 327 function that can be put into `org-agenda-skip-function' for the duration
 328 of a command."
 329   (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
 330   (let ((end (save-excursion (org-end-of-subtree t)))
 331         skip)
 332     (save-excursion
 333       (setq skip (re-search-forward org-agenda-skip-regexp end t)))
 334     (and skip end)))
 335
 336 (defun org-agenda-skip-subtree-when-regexp-matches ()
 337   "Check if the current subtree contains match for `org-agenda-skip-regexp'.
 338 If yes, it returns the end position of this tree, causing agenda commands
 339 to skip this subtree.  This is a function that can be put into
 340 `org-agenda-skip-function' for the duration of a command."
 341   (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
 342   (let ((end (save-excursion (org-end-of-subtree t)))
 343         skip)
 344     (save-excursion
 345       (setq skip (re-search-forward org-agenda-skip-regexp end t)))
 346     (and skip end)))
 347
 348 (defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
 349   "Check if the current subtree contains match for `org-agenda-skip-regexp'.
 350 If yes, it returns the end position of the current entry (NOT the tree),
 351 causing agenda commands to skip the entry but continuing the search in
 352 the subtree.  This is a function that can be put into
 353 `org-agenda-skip-function' for the duration of a command.  An important
 354 use of this function is for the stuck project list."
 355   (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
 356   (let ((end (save-excursion (org-end-of-subtree t)))
 357         (entry-end (save-excursion (outline-next-heading) (1- (point))))
 358         skip)
 359     (save-excursion
 360       (setq skip (re-search-forward org-agenda-skip-regexp end t)))
 361     (and skip entry-end)))
 362
 363 (define-obsolete-function-alias 'org-minutes-to-clocksum-string
 364   'org-duration-from-minutes "Org 9.1")
 365
 366 (define-obsolete-function-alias 'org-hh:mm-string-to-minutes
 367   'org-duration-to-minutes "Org 9.1")
 368
 369 (define-obsolete-function-alias 'org-duration-string-to-minutes
 370   'org-duration-to-minutes "Org 9.1")
 371
 372 (make-obsolete-variable 'org-time-clocksum-format
 373   "set `org-duration-format' instead." "Org 9.1")
 374
 375 (make-obsolete-variable 'org-time-clocksum-use-fractional
 376   "set `org-duration-format' instead." "Org 9.1")
 377
 378 (make-obsolete-variable 'org-time-clocksum-fractional-format
 379   "set `org-duration-format' instead." "Org 9.1")
 380
 381 (make-obsolete-variable 'org-time-clocksum-use-effort-durations
 382   "set `org-duration-units' instead." "Org 9.1")
 383
 384 (define-obsolete-function-alias 'org-babel-number-p
 385   'org-babel--string-to-number "Org 9.0")
 386
 387 (define-obsolete-variable-alias 'org-usenet-links-prefer-google
 388   'org-gnus-prefer-web-links "Org 9.1")
 389
 390 (define-obsolete-variable-alias 'org-texinfo-def-table-markup
 391   'org-texinfo-table-default-markup "Org 9.1")
 392
 393 ;; The function was made obsolete by commit 65399674d5 of 2013-02-22.
 394 ;; This make-obsolete call was added 2016-09-01.
 395 (make-obsolete 'org-capture-import-remember-templates
 396                "use the `org-capture-templates' variable instead."
 397                "Org 9.0")
 398
 399 (defun org-show-block-all ()
 400   "Unfold all blocks in the current buffer."
 401   (interactive)
 402   (remove-overlays nil nil 'invisible 'org-hide-block))
 403
 404 (make-obsolete 'org-show-block-all
 405                "use `org-show-all' instead."
 406                "Org 9.2")
 407
 408
 409 ;;;; Obsolete link types
 410
 411 (eval-after-load 'org
 412   '(progn
 413      (org-link-set-parameters "file+emacs") ;since Org 9.0
 414      (org-link-set-parameters "file+sys"))) ;since Org 9.0
 415
 416
 417 \f
 418 ;;; Miscellaneous functions
 419
 420 (defun org-version-check (version feature level)
 421   (let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
 422          (v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
 423          (rmaj (or (nth 0 v1) 99))
 424          (rmin (or (nth 1 v1) 99))
 425          (rbld (or (nth 2 v1) 99))
 426          (maj (or (nth 0 v2) 0))
 427          (min (or (nth 1 v2) 0))
 428          (bld (or (nth 2 v2) 0)))
 429     (if (or (< maj rmaj)
 430             (and (= maj rmaj)
 431                  (< min rmin))
 432             (and (= maj rmaj)
 433                  (= min rmin)
 434                  (< bld rbld)))
 435         (if (eq level :predicate)
 436             ;; just return if we have the version
 437             nil
 438           (let ((msg (format "Emacs %s or greater is recommended for %s"
 439                              version feature)))
 440             (display-warning 'org msg level)
 441             t))
 442       t)))
 443
 444 (defun org-get-x-clipboard (value)
 445   "Get the value of the X or Windows clipboard."
 446   (cond ((and (eq window-system 'x)
 447               (fboundp 'gui-get-selection)) ;Silence byte-compiler.
 448          (org-no-properties
 449           (ignore-errors
 450             (or (gui-get-selection value 'UTF8_STRING)
 451                 (gui-get-selection value 'COMPOUND_TEXT)
 452                 (gui-get-selection value 'STRING)
 453                 (gui-get-selection value 'TEXT)))))
 454         ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
 455          (w32-get-clipboard-data))))
 456
 457 (defun org-fit-window-to-buffer (&optional window max-height min-height
 458                                            shrink-only)
 459   "Fit WINDOW to the buffer, but only if it is not a side-by-side window.
 460 WINDOW defaults to the selected window.  MAX-HEIGHT and MIN-HEIGHT are
 461 passed through to `fit-window-to-buffer'.  If SHRINK-ONLY is set, call
 462 `shrink-window-if-larger-than-buffer' instead, the height limit is
 463 ignored in this case."
 464   (cond ((if (fboundp 'window-full-width-p)
 465              (not (window-full-width-p window))
 466            ;; do nothing if another window would suffer
 467            (> (frame-width) (window-width window))))
 468         ((and (fboundp 'fit-window-to-buffer) (not shrink-only))
 469          (fit-window-to-buffer window max-height min-height))
 470         ((fboundp 'shrink-window-if-larger-than-buffer)
 471          (shrink-window-if-larger-than-buffer window)))
 472   (or window (selected-window)))
 473
 474 ;; `set-transient-map' is only in Emacs >= 24.4
 475 (defalias 'org-set-transient-map
 476   (if (fboundp 'set-transient-map)
 477       'set-transient-map
 478     'set-temporary-overlay-map))
 479
 480 \f
 481 ;;; Region compatibility
 482
 483 (defvar org-ignore-region nil
 484   "Non-nil means temporarily disable the active region.")
 485
 486 (defun org-region-active-p ()
 487   "Non-nil when the region active.
 488 Unlike to `use-region-p', this function also checks
 489 `org-ignore-region'."
 490   (and (not org-ignore-region) (use-region-p)))
 491
 492 (defun org-cursor-to-region-beginning ()
 493   (when (and (org-region-active-p)
 494              (> (point) (region-beginning)))
 495     (exchange-point-and-mark)))
 496
 497 \f
 498 ;;; Invisibility compatibility
 499
 500 (defun org-remove-from-invisibility-spec (arg)
 501   "Remove elements from `buffer-invisibility-spec'."
 502   (if (fboundp 'remove-from-invisibility-spec)
 503       (remove-from-invisibility-spec arg)
 504     (if (consp buffer-invisibility-spec)
 505         (setq buffer-invisibility-spec
 506               (delete arg buffer-invisibility-spec)))))
 507
 508 (defun org-in-invisibility-spec-p (arg)
 509   "Is ARG a member of `buffer-invisibility-spec'?"
 510   (if (consp buffer-invisibility-spec)
 511       (member arg buffer-invisibility-spec)))
 512
 513 (defun org-move-to-column (column &optional force _buffer)
 514   "Move to column COLUMN.
 515 Pass COLUMN and FORCE to `move-to-column'."
 516   (let ((buffer-invisibility-spec
 517          (if (listp buffer-invisibility-spec)
 518              (remove '(org-filtered) buffer-invisibility-spec)
 519            buffer-invisibility-spec)))
 520     (move-to-column column force)))
 521
 522 (defmacro org-find-library-dir (library)
 523   `(file-name-directory (or (locate-library ,library) "")))
 524
 525 (defun org-count-lines (s)
 526   "How many lines in string S?"
 527   (let ((start 0) (n 1))
 528     (while (string-match "\n" s start)
 529       (setq start (match-end 0) n (1+ n)))
 530     (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
 531         (setq n (1- n)))
 532     n))
 533
 534 (defun org-kill-new (string &rest args)
 535   (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
 536                           string)
 537   (apply 'kill-new string args))
 538
 539 ;; `font-lock-ensure' is only available from 24.4.50 on
 540 (defalias 'org-font-lock-ensure
 541   (if (fboundp 'font-lock-ensure)
 542       #'font-lock-ensure
 543     (lambda (&optional _beg _end)
 544       (with-no-warnings (font-lock-fontify-buffer)))))
 545
 546 ;; `file-local-name' was added in Emacs 26.1.
 547 (defalias 'org-babel-local-file-name
 548   (if (fboundp 'file-local-name)
 549       'file-local-name
 550     (lambda (file)
 551       "Return the local name component of FILE."
 552       (or (file-remote-p file 'localname) file))))
 553
 554 (defmacro org-no-popups (&rest body)
 555   "Suppress popup windows.
 556 Let-bind some variables to nil around BODY to achieve the desired
 557 effect, which variables to use depends on the Emacs version."
 558   (if (org-version-check "24.2.50" "" :predicate)
 559       `(let (pop-up-frames display-buffer-alist)
 560          ,@body)
 561     `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
 562        ,@body)))
 563
 564 ;;;###autoload
 565 (defmacro org-check-version ()
 566   "Try very hard to provide sensible version strings."
 567   (let* ((org-dir        (org-find-library-dir "org"))
 568          (org-version.el (concat org-dir "org-version.el"))
 569          (org-fixup.el   (concat org-dir "../mk/org-fixup.el")))
 570     (if (require 'org-version org-version.el 'noerror)
 571         '(progn
 572            (autoload 'org-release     "org-version.el")
 573            (autoload 'org-git-version "org-version.el"))
 574       (if (require 'org-fixup org-fixup.el 'noerror)
 575           '(org-fixup)
 576         ;; provide fallback definitions and complain
 577         (warn "Could not define org version correctly.  Check installation!")
 578         '(progn
 579            (defun org-release () "N/A")
 580            (defun org-git-version () "N/A !!check installation!!"))))))
 581
 582 (defmacro org-with-silent-modifications (&rest body)
 583   (if (fboundp 'with-silent-modifications)
 584       `(with-silent-modifications ,@body)
 585     `(org-unmodified ,@body)))
 586 (def-edebug-spec org-with-silent-modifications (body))
 587
 588 \f
 589 ;;; Functions for Emacs < 24.4 compatibility
 590
 591 (defun org-define-error (name message)
 592   "Define NAME as a new error signal.
 593 MESSAGE is a string that will be output to the echo area if such
 594 an error is signaled without being caught by a `condition-case'.
 595 Implements `define-error' for older emacsen."
 596   (if (fboundp 'define-error) (define-error name message)
 597     (put name 'error-conditions
 598          (copy-sequence (cons name (get 'error 'error-conditions))))))
 599
 600 (unless (fboundp 'string-suffix-p)
 601   ;; From Emacs subr.el.
 602   (defun string-suffix-p (suffix string  &optional ignore-case)
 603     "Return non-nil if SUFFIX is a suffix of STRING.
 604 If IGNORE-CASE is non-nil, the comparison is done without paying
 605 attention to case differences."
 606     (let ((start-pos (- (length string) (length suffix))))
 607       (and (>= start-pos 0)
 608            (eq t (compare-strings suffix nil nil
 609                                   string start-pos nil ignore-case))))))
 610
 611 \f
 612 ;;; Integration with and fixes for other packages
 613
 614 (defgroup org-imenu-and-speedbar nil
 615   "Options concerning imenu and speedbar in Org mode."
 616   :tag "Org Imenu and Speedbar"
 617   :group 'org-structure)
 618
 619 (defcustom org-imenu-depth 2
 620   "The maximum level for Imenu access to Org headlines.
 621 This also applied for speedbar access."
 622   :group 'org-imenu-and-speedbar
 623   :type 'integer)
 624
 625 ;;;; Imenu
 626
 627 (defvar-local org-imenu-markers nil
 628   "All markers currently used by Imenu.")
 629
 630 (defun org-imenu-new-marker (&optional pos)
 631   "Return a new marker for use by Imenu, and remember the marker."
 632   (let ((m (make-marker)))
 633     (move-marker m (or pos (point)))
 634     (push m org-imenu-markers)
 635     m))
 636
 637 (defun org-imenu-get-tree ()
 638   "Produce the index for Imenu."
 639   (dolist (x org-imenu-markers) (move-marker x nil))
 640   (setq org-imenu-markers nil)
 641   (let* ((case-fold-search nil)
 642          (n org-imenu-depth)
 643          (re (concat "^" (org-get-limited-outline-regexp)))
 644          (subs (make-vector (1+ n) nil))
 645          (last-level 0)
 646          m level head0 head)
 647     (org-with-wide-buffer
 648      (goto-char (point-max))
 649      (while (re-search-backward re nil t)
 650        (setq level (org-reduced-level (funcall outline-level)))
 651        (when (and (<= level n)
 652                   (looking-at org-complex-heading-regexp)
 653                   (setq head0 (match-string-no-properties 4)))
 654          (setq head (org-link-display-format head0)
 655                m (org-imenu-new-marker))
 656          (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
 657          (if (>= level last-level)
 658              (push (cons head m) (aref subs level))
 659            (push (cons head (aref subs (1+ level))) (aref subs level))
 660            (cl-loop for i from (1+ level) to n do (aset subs i nil)))
 661          (setq last-level level))))
 662     (aref subs 1)))
 663
 664 (eval-after-load "imenu"
 665   '(progn
 666      (add-hook 'imenu-after-jump-hook
 667                (lambda ()
 668                  (when (derived-mode-p 'org-mode)
 669                    (org-show-context 'org-goto))))))
 670
 671 ;;;; Speedbar
 672
 673 (defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
 674   "Overlay marking the agenda restriction line in speedbar.")
 675 (overlay-put org-speedbar-restriction-lock-overlay
 676              'face 'org-agenda-restriction-lock)
 677 (overlay-put org-speedbar-restriction-lock-overlay
 678              'help-echo "Agendas are currently limited to this item.")
 679 (delete-overlay org-speedbar-restriction-lock-overlay)
 680
 681 (defun org-speedbar-set-agenda-restriction ()
 682   "Restrict future agenda commands to the location at point in speedbar.
 683 To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
 684   (interactive)
 685   (require 'org-agenda)
 686   (let (p m tp np dir txt)
 687     (cond
 688      ((setq p (text-property-any (point-at-bol) (point-at-eol)
 689                                  'org-imenu t))
 690       (setq m (get-text-property p 'org-imenu-marker))
 691       (with-current-buffer (marker-buffer m)
 692         (goto-char m)
 693         (org-agenda-set-restriction-lock 'subtree)))
 694      ((setq p (text-property-any (point-at-bol) (point-at-eol)
 695                                  'speedbar-function 'speedbar-find-file))
 696       (setq tp (previous-single-property-change
 697                 (1+ p) 'speedbar-function)
 698             np (next-single-property-change
 699                 tp 'speedbar-function)
 700             dir (speedbar-line-directory)
 701             txt (buffer-substring-no-properties (or tp (point-min))
 702                                                 (or np (point-max))))
 703       (with-current-buffer (find-file-noselect
 704                             (let ((default-directory dir))
 705                               (expand-file-name txt)))
 706         (unless (derived-mode-p 'org-mode)
 707           (user-error "Cannot restrict to non-Org mode file"))
 708         (org-agenda-set-restriction-lock 'file)))
 709      (t (user-error "Don't know how to restrict Org mode agenda")))
 710     (move-overlay org-speedbar-restriction-lock-overlay
 711                   (point-at-bol) (point-at-eol))
 712     (setq current-prefix-arg nil)
 713     (org-agenda-maybe-redo)))
 714
 715 (defvar speedbar-file-key-map)
 716 (declare-function speedbar-add-supported-extension "speedbar" (extension))
 717 (eval-after-load "speedbar"
 718   '(progn
 719      (speedbar-add-supported-extension ".org")
 720      (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
 721      (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
 722      (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
 723      (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
 724      (add-hook 'speedbar-visiting-tag-hook
 725                (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
 726
 727 ;;;; Flyspell
 728
 729 (defun org--flyspell-object-check-p (element)
 730   "Non-nil when Flyspell can check object at point.
 731 ELEMENT is the element at point."
 732   (let ((object (save-excursion
 733                   (when (looking-at-p "\\>") (backward-char))
 734                   (org-element-context element))))
 735     (cl-case (org-element-type object)
 736       ;; Prevent checks in links due to keybinding conflict with
 737       ;; Flyspell.
 738       ((code entity export-snippet inline-babel-call
 739              inline-src-block line-break latex-fragment link macro
 740              statistics-cookie target timestamp verbatim)
 741        nil)
 742       (footnote-reference
 743        ;; Only in inline footnotes, within the definition.
 744        (and (eq (org-element-property :type object) 'inline)
 745             (< (save-excursion
 746                  (goto-char (org-element-property :begin object))
 747                  (search-forward ":" nil t 2))
 748                (point))))
 749       (otherwise t))))
 750
 751 (defun org-mode-flyspell-verify ()
 752   "Function used for `flyspell-generic-check-word-predicate'."
 753   (if (org-at-heading-p)
 754       ;; At a headline or an inlinetask, check title only.  This is
 755       ;; faster than relying on `org-element-at-point'.
 756       (and (save-excursion (beginning-of-line)
 757                            (and (let ((case-fold-search t))
 758                                   (not (looking-at-p "\\*+ END[ \t]*$")))
 759                                 (let ((case-fold-search nil))
 760                                   (looking-at org-complex-heading-regexp))))
 761            (match-beginning 4)
 762            (>= (point) (match-beginning 4))
 763            (or (not (match-beginning 5))
 764                (< (point) (match-beginning 5))))
 765     (let* ((element (org-element-at-point))
 766            (post-affiliated (org-element-property :post-affiliated element)))
 767       (cond
 768        ;; Ignore checks in all affiliated keywords but captions.
 769        ((< (point) post-affiliated)
 770         (and (save-excursion
 771                (beginning-of-line)
 772                (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
 773              (> (point) (match-end 0))
 774              (org--flyspell-object-check-p element)))
 775        ;; Ignore checks in LOGBOOK (or equivalent) drawer.
 776        ((let ((log (org-log-into-drawer)))
 777           (and log
 778                (let ((drawer (org-element-lineage element '(drawer))))
 779                  (and drawer
 780                       (eq (compare-strings
 781                            log nil nil
 782                            (org-element-property :drawer-name drawer) nil nil t)
 783                           t)))))
 784         nil)
 785        (t
 786         (cl-case (org-element-type element)
 787           ((comment quote-section) t)
 788           (comment-block
 789            ;; Allow checks between block markers, not on them.
 790            (and (> (line-beginning-position) post-affiliated)
 791                 (save-excursion
 792                   (end-of-line)
 793                   (skip-chars-forward " \r\t\n")
 794                   (< (point) (org-element-property :end element)))))
 795           ;; Arbitrary list of keywords where checks are meaningful.
 796           ;; Make sure point is on the value part of the element.
 797           (keyword
 798            (and (member (org-element-property :key element)
 799                         '("DESCRIPTION" "TITLE"))
 800                 (save-excursion
 801                   (search-backward ":" (line-beginning-position) t))))
 802           ;; Check is globally allowed in paragraphs verse blocks and
 803           ;; table rows (after affiliated keywords) but some objects
 804           ;; must not be affected.
 805           ((paragraph table-row verse-block)
 806            (let ((cbeg (org-element-property :contents-begin element))
 807                  (cend (org-element-property :contents-end element)))
 808              (and cbeg (>= (point) cbeg) (< (point) cend)
 809                   (org--flyspell-object-check-p element))))))))))
 810 (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
 811
 812 (defun org-remove-flyspell-overlays-in (beg end)
 813   "Remove flyspell overlays in region."
 814   (and (bound-and-true-p flyspell-mode)
 815        (fboundp 'flyspell-delete-region-overlays)
 816        (flyspell-delete-region-overlays beg end)))
 817
 818 (defvar flyspell-delayed-commands)
 819 (eval-after-load "flyspell"
 820   '(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
 821
 822 ;;;; Bookmark
 823
 824 (defun org-bookmark-jump-unhide ()
 825   "Unhide the current position, to show the bookmark location."
 826   (and (derived-mode-p 'org-mode)
 827        (or (org-invisible-p)
 828            (save-excursion (goto-char (max (point-min) (1- (point))))
 829                            (org-invisible-p)))
 830        (org-show-context 'bookmark-jump)))
 831
 832 ;; Make `bookmark-jump' shows the jump location if it was hidden.
 833 (eval-after-load "bookmark"
 834   '(if (boundp 'bookmark-after-jump-hook)
 835        ;; We can use the hook
 836        (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
 837      ;; Hook not available, use advice
 838      (defadvice bookmark-jump (after org-make-visible activate)
 839        "Make the position visible."
 840        (org-bookmark-jump-unhide))))
 841
 842 ;;;; Calendar
 843
 844 (defcustom org-calendar-to-agenda-key 'default
 845   "Key to be installed in `calendar-mode-map' for switching to the agenda.
 846
 847 The command `org-calendar-goto-agenda' will be bound to this key.
 848
 849 When set to `default', bind the function to `c', but only if it is
 850 available in the Calendar keymap.  This is the default choice because
 851 `c' can then be used to switch back and forth between agenda and calendar.
 852
 853 When nil, `org-calendar-goto-agenda' is not bound to any key."
 854   :group 'org-agenda
 855   :type '(choice
 856           (const :tag "Bind to `c' if available" default)
 857           (key-sequence :tag "Other binding")
 858           (const :tag "No binding" nil))
 859   :safe (lambda (v) (or (symbolp v) (stringp v)))
 860   :package-version '(Org . "9.2"))
 861
 862 (defcustom org-calendar-insert-diary-entry-key [?i]
 863   "The key to be installed in `calendar-mode-map' for adding diary entries.
 864 This option is irrelevant until `org-agenda-diary-file' has been configured
 865 to point to an Org file.  When that is the case, the command
 866 `org-agenda-diary-entry' will be bound to the key given here, by default
 867 `i'.  In the calendar, `i' normally adds entries to `diary-file'.  So
 868 if you want to continue doing this, you need to change this to a different
 869 key."
 870   :group 'org-agenda
 871   :type 'sexp)
 872
 873 (defun org--setup-calendar-bindings ()
 874   "Bind Org functions in Calendar keymap."
 875   (pcase org-calendar-to-agenda-key
 876     (`nil nil)
 877     ((and key (pred stringp))
 878      (local-set-key (kbd key) #'org-calendar-goto-agenda))
 879     ((guard (not (lookup-key calendar-mode-map "c")))
 880      (local-set-key "c" #'org-calendar-goto-agenda))
 881     (_ nil))
 882   (unless (eq org-agenda-diary-file 'diary-file)
 883     (local-set-key org-calendar-insert-diary-entry-key
 884                    #'org-agenda-diary-entry)))
 885
 886 (eval-after-load "calendar"
 887   '(add-hook 'calendar-mode-hook #'org--setup-calendar-bindings))
 888
 889 ;;;; Saveplace
 890
 891 ;; Make sure saveplace shows the location if it was hidden
 892 (eval-after-load "saveplace"
 893   '(defadvice save-place-find-file-hook (after org-make-visible activate)
 894      "Make the position visible."
 895      (org-bookmark-jump-unhide)))
 896
 897 ;;;; Ecb
 898
 899 ;; Make sure ecb shows the location if it was hidden
 900 (eval-after-load "ecb"
 901   '(defadvice ecb-method-clicked (after esf/org-show-context activate)
 902      "Make hierarchy visible when jumping into location from ECB tree buffer."
 903      (when (derived-mode-p 'org-mode)
 904        (org-show-context))))
 905
 906 ;;;; Simple
 907
 908 (defun org-mark-jump-unhide ()
 909   "Make the point visible with `org-show-context' after jumping to the mark."
 910   (when (and (derived-mode-p 'org-mode)
 911              (org-invisible-p))
 912     (org-show-context 'mark-goto)))
 913
 914 (eval-after-load "simple"
 915   '(defadvice pop-to-mark-command (after org-make-visible activate)
 916      "Make the point visible with `org-show-context'."
 917      (org-mark-jump-unhide)))
 918
 919 (eval-after-load "simple"
 920   '(defadvice exchange-point-and-mark (after org-make-visible activate)
 921      "Make the point visible with `org-show-context'."
 922      (org-mark-jump-unhide)))
 923
 924 (eval-after-load "simple"
 925   '(defadvice pop-global-mark (after org-make-visible activate)
 926      "Make the point visible with `org-show-context'."
 927      (org-mark-jump-unhide)))
 928
 929 ;;;; Session
 930
 931 ;; Make "session.el" ignore our circular variable.
 932 (defvar session-globals-exclude)
 933 (eval-after-load "session"
 934   '(add-to-list 'session-globals-exclude 'org-mark-ring))
 935
 936 (provide 'org-compat)
 937
 938 ;;; org-compat.el ends here