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