| commit | author | age | ||
| 76bbd0 | 1 | ;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*- |
| C | 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. | |
| 29 | ||
| 30 | ;;; Code: | |
| 31 | ||
| 32 | (require 'cl-lib) | |
| 33 | (require 'org-macs) | |
| 34 | ||
| 35 | (declare-function org-at-table.el-p "org" ()) | |
| 36 | (declare-function org-element-at-point "org-element" ()) | |
| 37 | (declare-function org-element-type "org-element" (element)) | |
| 38 | (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) | |
| 39 | (declare-function org-link-set-parameters "org" (type &rest rest)) | |
| 40 | (declare-function org-table-end "org-table" (&optional table-type)) | |
| 41 | (declare-function outline-next-heading "outline" ()) | |
| 42 | (declare-function table--at-cell-p "table" (position &optional object at-column)) | |
| 43 | ||
| 44 | (defvar org-table-any-border-regexp) | |
| 45 | (defvar org-table-dataline-regexp) | |
| 46 | (defvar org-table-tab-recognizes-table.el) | |
| 47 | (defvar org-table1-hline-regexp) | |
| 48 | ||
| 49 | ;;; Emacs < 25.1 compatibility | |
| 50 | ||
| 51 | (when (< emacs-major-version 25) | |
| 52 | (defalias 'outline-hide-entry 'hide-entry) | |
| 53 | (defalias 'outline-hide-sublevels 'hide-sublevels) | |
| 54 | (defalias 'outline-hide-subtree 'hide-subtree) | |
| 55 | (defalias 'outline-show-all 'show-all) | |
| 56 | (defalias 'outline-show-branches 'show-branches) | |
| 57 | (defalias 'outline-show-children 'show-children) | |
| 58 | (defalias 'outline-show-entry 'show-entry) | |
| 59 | (defalias 'outline-show-subtree 'show-subtree) | |
| 60 | (defalias 'xref-find-definitions 'find-tag) | |
| 61 | (defalias 'format-message 'format) | |
| 62 | (defalias 'gui-get-selection 'x-get-selection)) | |
| 63 | ||
| 64 | (unless (fboundp 'directory-name-p) | |
| 65 | (defun directory-name-p (name) | |
| 66 | "Return non-nil if NAME ends with a directory separator character." | |
| 67 | (let ((len (length name)) | |
| 68 | (lastc ?.)) | |
| 69 | (if (> len 0) | |
| 70 | (setq lastc (aref name (1- len)))) | |
| 71 | (or (= lastc ?/) | |
| 72 | (and (memq system-type '(windows-nt ms-dos)) | |
| 73 | (= lastc ?\\)))))) | |
| 74 | ||
| 75 | ||
| 76 | ;;; Obsolete aliases (remove them after the next major release). | |
| 77 | ||
| 78 | ;;;; XEmacs compatibility, now removed. | |
| 79 | (define-obsolete-function-alias 'org-activate-mark 'activate-mark) | |
| 80 | (define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0") | |
| 81 | (define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0") | |
| 82 | (define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0") | |
| 83 | (define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0") | |
| 84 | (define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0") | |
| 85 | (define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0") | |
| 86 | (define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0") | |
| 87 | (define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0") | |
| 88 | (define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0") | |
| 89 | (define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0") | |
| 90 | (define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0") | |
| 91 | (define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0") | |
| 92 | (define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0") | |
| 93 | (define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0") | |
| 94 | ||
| 95 | (defmacro org-re (s) | |
| 96 | "Replace posix classes in regular expression S." | |
| 97 | (declare (debug (form)) | |
| 98 | (obsolete "you can safely remove it." "Org 9.0")) | |
| 99 | s) | |
| 100 | ||
| 101 | ;;;; Functions from cl-lib that Org used to have its own implementation of. | |
| 102 | (define-obsolete-function-alias 'org-count 'cl-count "Org 9.0") | |
| 103 | (define-obsolete-function-alias 'org-every 'cl-every "Org 9.0") | |
| 104 | (define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0") | |
| 105 | (define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0") | |
| 106 | (define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0") | |
| 107 | (define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0") | |
| 108 | (define-obsolete-function-alias 'org-some 'cl-some "Org 9.0") | |
| 109 | (define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0") | |
| 110 | ||
| 111 | (defun org-sublist (list start end) | |
| 112 | "Return a section of LIST, from START to END. | |
| 113 | Counting starts at 1." | |
| 114 | (cl-subseq list (1- start) end)) | |
| 115 | (make-obsolete 'org-sublist | |
| 116 | "use cl-subseq (note the 0-based counting)." | |
| 117 | "Org 9.0") | |
| 118 | ||
| 119 | ||
| 120 | ;;;; Functions available since Emacs 24.3 | |
| 121 | (define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0") | |
| 122 | (define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "Org 9.0") | |
| 123 | (define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0") | |
| 124 | (define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0") | |
| 125 | (define-obsolete-function-alias 'org-format-seconds 'format-seconds "Org 9.0") | |
| 126 | (define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "Org 9.0") | |
| 127 | (define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "Org 9.0") | |
| 128 | (define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0") | |
| 129 | (define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0") | |
| 130 | (define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0") | |
| 131 | ||
| 132 | ;;;; Functions and variables from previous releases now obsolete. | |
| 133 | (define-obsolete-function-alias 'org-element-remove-indentation | |
| 134 | 'org-remove-indentation "Org 9.0") | |
| 135 | (define-obsolete-variable-alias 'org-latex-create-formula-image-program | |
| 136 | 'org-preview-latex-default-process "Org 9.0") | |
| 137 | (define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory | |
| 138 | 'org-preview-latex-image-directory "Org 9.0") | |
| 139 | (define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0") | |
| 140 | (define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0") | |
| 141 | (define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3") | |
| 142 | (define-obsolete-function-alias 'org-image-file-name-regexp | |
| 143 | 'image-file-name-regexp "Org 9.0") | |
| 144 | (define-obsolete-function-alias 'org-completing-read-no-i | |
| 145 | 'completing-read "Org 9.0") | |
| 146 | (define-obsolete-function-alias 'org-icompleting-read | |
| 147 | 'completing-read "Org 9.0") | |
| 148 | (define-obsolete-function-alias 'org-iread-file-name 'read-file-name "Org 9.0") | |
| 149 | (define-obsolete-function-alias 'org-days-to-time | |
| 150 | 'org-time-stamp-to-now "Org 8.2") | |
| 151 | (define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties | |
| 152 | 'org-agenda-ignore-properties "Org 9.0") | |
| 153 | (define-obsolete-function-alias 'org-preview-latex-fragment | |
| 154 | 'org-toggle-latex-fragment "Org 8.3") | |
| 155 | (define-obsolete-function-alias 'org-export-get-genealogy | |
| 156 | 'org-element-lineage "Org 9.0") | |
| 157 | (define-obsolete-variable-alias 'org-latex-with-hyperref | |
| 158 | 'org-latex-hyperref-template "Org 9.0") | |
| 159 | (define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0") | |
| 160 | (define-obsolete-variable-alias 'org-export-htmlized-org-css-url | |
| 161 | 'org-org-htmlized-css-url "Org 8.2") | |
| 162 | (define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.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-variable-alias 'org-babel-capitalize-example-region-markers | |
| 168 | 'org-babel-uppercase-example-markers "Org 9.1") | |
| 169 | ||
| 170 | (define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0") | |
| 171 | (define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") | |
| 172 | (define-obsolete-function-alias 'org-insert-columns-dblock | |
| 173 | 'org-columns-insert-dblock "Org 9.0") | |
| 174 | (define-obsolete-variable-alias 'org-export-babel-evaluate | |
| 175 | 'org-export-use-babel "Org 9.1") | |
| 176 | (define-obsolete-function-alias 'org-activate-bracket-links | |
| 177 | 'org-activate-links "Org 9.0") | |
| 178 | (define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0") | |
| 179 | (define-obsolete-function-alias 'org-activate-angle-links 'ignore "Org 9.0") | |
| 180 | ||
| 181 | (defun org-in-fixed-width-region-p () | |
| 182 | "Non-nil if point in a fixed-width region." | |
| 183 | (save-match-data | |
| 184 | (eq 'fixed-width (org-element-type (org-element-at-point))))) | |
| 185 | (make-obsolete 'org-in-fixed-width-region-p | |
| 186 | "use `org-element' library" | |
| 187 | "Org 9.0") | |
| 188 | ||
| 189 | (defun org-compatible-face (inherits specs) | |
| 190 | "Make a compatible face specification. | |
| 191 | If INHERITS is an existing face and if the Emacs version supports | |
| 192 | it, just inherit the face. If INHERITS is not given and SPECS | |
| 193 | is, use SPECS to define the face." | |
| 194 | (declare (indent 1)) | |
| 195 | (if (facep inherits) | |
| 196 | (list (list t :inherit inherits)) | |
| 197 | specs)) | |
| 198 | (make-obsolete 'org-compatible-face "you can remove it." "Org 9.0") | |
| 199 | ||
| 200 | (defun org-add-link-type (type &optional follow export) | |
| 201 | "Add a new TYPE link. | |
| 202 | FOLLOW and EXPORT are two functions. | |
| 203 | ||
| 204 | FOLLOW should take the link path as the single argument and do whatever | |
| 205 | is necessary to follow the link, for example find a file or display | |
| 206 | a mail message. | |
| 207 | ||
| 208 | EXPORT should format the link path for export to one of the export formats. | |
| 209 | It should be a function accepting three arguments: | |
| 210 | ||
| 211 | path the path of the link, the text after the prefix (like \"http:\") | |
| 212 | desc the description of the link, if any | |
| 213 | format the export format, a symbol like `html' or `latex' or `ascii'. | |
| 214 | ||
| 215 | The function may use the FORMAT information to return different values | |
| 216 | depending on the format. The return value will be put literally into | |
| 217 | the exported file. If the return value is nil, this means Org should | |
| 218 | do what it normally does with links which do not have EXPORT defined. | |
| 219 | ||
| 220 | Org mode has a built-in default for exporting links. If you are happy with | |
| 221 | this default, there is no need to define an export function for the link | |
| 222 | type. For a simple example of an export function, see `org-bbdb.el'. | |
| 223 | ||
| 224 | If TYPE already exists, update it with the arguments. | |
| 225 | See `org-link-parameters' for documentation on the other parameters." | |
| 226 | (org-link-set-parameters type :follow follow :export export) | |
| 227 | (message "Created %s link." type)) | |
| 228 | ||
| 229 | (make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0") | |
| 230 | ||
| 231 | (defun org-table-recognize-table.el () | |
| 232 | "If there is a table.el table nearby, recognize it and move into it." | |
| 233 | (when (and org-table-tab-recognizes-table.el (org-at-table.el-p)) | |
| 234 | (beginning-of-line) | |
| 235 | (unless (or (looking-at org-table-dataline-regexp) | |
| 236 | (not (looking-at org-table1-hline-regexp))) | |
| 237 | (forward-line) | |
| 238 | (when (looking-at org-table-any-border-regexp) | |
| 239 | (forward-line -2))) | |
| 240 | (if (re-search-forward "|" (org-table-end t) t) | |
| 241 | (progn | |
| 242 | (require 'table) | |
| 243 | (if (table--at-cell-p (point)) t | |
| 244 | (message "recognizing table.el table...") | |
| 245 | (table-recognize-table) | |
| 246 | (message "recognizing table.el table...done"))) | |
| 247 | (error "This should not happen")))) | |
| 248 | ||
| 249 | ;; Not used by Org core since commit 6d1e3082, Feb 2010. | |
| 250 | (make-obsolete 'org-table-recognize-table.el | |
| 251 | "please notify the org mailing list if you use this function." | |
| 252 | "Org 9.0") | |
| 253 | ||
| 254 | (defun org-remove-angle-brackets (s) | |
| 255 | (org-unbracket-string "<" ">" s)) | |
| 256 | (make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0") | |
| 257 | ||
| 258 | (defun org-remove-double-quotes (s) | |
| 259 | (org-unbracket-string "\"" "\"" s)) | |
| 260 | (make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0") | |
| 261 | ||
| 262 | (defcustom org-publish-sitemap-file-entry-format "%t" | |
| 263 | "Format string for site-map file entry. | |
| 264 | You could use brackets to delimit on what part the link will be. | |
| 265 | ||
| 266 | %t is the title. | |
| 267 | %a is the author. | |
| 268 | %d is the date formatted using `org-publish-sitemap-date-format'." | |
| 269 | :group 'org-export-publish | |
| 270 | :type 'string) | |
| 271 | (make-obsolete-variable | |
| 272 | 'org-publish-sitemap-file-entry-format | |
| 273 | "set `:sitemap-format-entry' in `org-publish-project-alist' instead." | |
| 274 | "Org 9.1") | |
| 275 | ||
| 276 | (defvar org-agenda-skip-regexp) | |
| 277 | (defun org-agenda-skip-entry-when-regexp-matches () | |
| 278 | "Check if the current entry contains match for `org-agenda-skip-regexp'. | |
| 279 | If yes, it returns the end position of this entry, causing agenda commands | |
| 280 | to skip the entry but continuing the search in the subtree. This is a | |
| 281 | function that can be put into `org-agenda-skip-function' for the duration | |
| 282 | of a command." | |
| 283 | (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1")) | |
| 284 | (let ((end (save-excursion (org-end-of-subtree t))) | |
| 285 | skip) | |
| 286 | (save-excursion | |
| 287 | (setq skip (re-search-forward org-agenda-skip-regexp end t))) | |
| 288 | (and skip end))) | |
| 289 | ||
| 290 | (defun org-agenda-skip-subtree-when-regexp-matches () | |
| 291 | "Check if the current subtree contains match for `org-agenda-skip-regexp'. | |
| 292 | If yes, it returns the end position of this tree, causing agenda commands | |
| 293 | to skip this subtree. This is a function that can be put into | |
| 294 | `org-agenda-skip-function' for the duration of a command." | |
| 295 | (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1")) | |
| 296 | (let ((end (save-excursion (org-end-of-subtree t))) | |
| 297 | skip) | |
| 298 | (save-excursion | |
| 299 | (setq skip (re-search-forward org-agenda-skip-regexp end t))) | |
| 300 | (and skip end))) | |
| 301 | ||
| 302 | (defun org-agenda-skip-entry-when-regexp-matches-in-subtree () | |
| 303 | "Check if the current subtree contains match for `org-agenda-skip-regexp'. | |
| 304 | If yes, it returns the end position of the current entry (NOT the tree), | |
| 305 | causing agenda commands to skip the entry but continuing the search in | |
| 306 | the subtree. This is a function that can be put into | |
| 307 | `org-agenda-skip-function' for the duration of a command. An important | |
| 308 | use of this function is for the stuck project list." | |
| 309 | (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1")) | |
| 310 | (let ((end (save-excursion (org-end-of-subtree t))) | |
| 311 | (entry-end (save-excursion (outline-next-heading) (1- (point)))) | |
| 312 | skip) | |
| 313 | (save-excursion | |
| 314 | (setq skip (re-search-forward org-agenda-skip-regexp end t))) | |
| 315 | (and skip entry-end))) | |
| 316 | ||
| 317 | (define-obsolete-function-alias 'org-minutes-to-clocksum-string | |
| 318 | 'org-duration-from-minutes "Org 9.1") | |
| 319 | ||
| 320 | (define-obsolete-function-alias 'org-hh:mm-string-to-minutes | |
| 321 | 'org-duration-to-minutes "Org 9.1") | |
| 322 | ||
| 323 | (define-obsolete-function-alias 'org-duration-string-to-minutes | |
| 324 | 'org-duration-to-minutes "Org 9.1") | |
| 325 | ||
| 326 | (make-obsolete-variable 'org-time-clocksum-format | |
| 327 | "set `org-duration-format' instead." "Org 9.1") | |
| 328 | ||
| 329 | (make-obsolete-variable 'org-time-clocksum-use-fractional | |
| 330 | "set `org-duration-format' instead." "Org 9.1") | |
| 331 | ||
| 332 | (make-obsolete-variable 'org-time-clocksum-fractional-format | |
| 333 | "set `org-duration-format' instead." "Org 9.1") | |
| 334 | ||
| 335 | (make-obsolete-variable 'org-time-clocksum-use-effort-durations | |
| 336 | "set `org-duration-units' instead." "Org 9.1") | |
| 337 | ||
| 338 | (define-obsolete-function-alias 'org-babel-number-p | |
| 339 | 'org-babel--string-to-number "Org 9.0") | |
| 340 | ||
| 341 | (define-obsolete-variable-alias 'org-usenet-links-prefer-google | |
| 342 | 'org-gnus-prefer-web-links "Org 9.1") | |
| 343 | ||
| 344 | (define-obsolete-variable-alias 'org-texinfo-def-table-markup | |
| 345 | 'org-texinfo-table-default-markup "Org 9.1") | |
| 346 | ||
| 347 | ;;; The function was made obsolete by commit 65399674d5 of 2013-02-22. | |
| 348 | ;;; This make-obsolete call was added 2016-09-01. | |
| 349 | (make-obsolete 'org-capture-import-remember-templates | |
| 350 | "use the `org-capture-templates' variable instead." | |
| 351 | "Org 9.0") | |
| 352 | ||
| 353 | ||
| 354 | ;;;; Obsolete link types | |
| 355 | ||
| 356 | (eval-after-load 'org | |
| 357 | '(progn | |
| 358 | (org-link-set-parameters "file+emacs") ;since Org 9.0 | |
| 359 | (org-link-set-parameters "file+sys"))) ;since Org 9.0 | |
| 360 | ||
| 361 | ||
| 362 | ||
| 363 | ;;; Miscellaneous functions | |
| 364 | ||
| 365 | (defun org-version-check (version feature level) | |
| 366 | (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) | |
| 367 | (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) | |
| 368 | (rmaj (or (nth 0 v1) 99)) | |
| 369 | (rmin (or (nth 1 v1) 99)) | |
| 370 | (rbld (or (nth 2 v1) 99)) | |
| 371 | (maj (or (nth 0 v2) 0)) | |
| 372 | (min (or (nth 1 v2) 0)) | |
| 373 | (bld (or (nth 2 v2) 0))) | |
| 374 | (if (or (< maj rmaj) | |
| 375 | (and (= maj rmaj) | |
| 376 | (< min rmin)) | |
| 377 | (and (= maj rmaj) | |
| 378 | (= min rmin) | |
| 379 | (< bld rbld))) | |
| 380 | (if (eq level :predicate) | |
| 381 | ;; just return if we have the version | |
| 382 | nil | |
| 383 | (let ((msg (format "Emacs %s or greater is recommended for %s" | |
| 384 | version feature))) | |
| 385 | (display-warning 'org msg level) | |
| 386 | t)) | |
| 387 | t))) | |
| 388 | ||
| 389 | (defun org-get-x-clipboard (value) | |
| 390 | "Get the value of the X or Windows clipboard." | |
| 391 | (cond ((and (eq window-system 'x) | |
| 392 | (fboundp 'gui-get-selection)) ;Silence byte-compiler. | |
| 393 | (org-no-properties | |
| 394 | (ignore-errors | |
| 395 | (or (gui-get-selection value 'UTF8_STRING) | |
| 396 | (gui-get-selection value 'COMPOUND_TEXT) | |
| 397 | (gui-get-selection value 'STRING) | |
| 398 | (gui-get-selection value 'TEXT))))) | |
| 399 | ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) | |
| 400 | (w32-get-clipboard-data)))) | |
| 401 | ||
| 402 | (defun org-add-props (string plist &rest props) | |
| 403 | "Add text properties to entire string, from beginning to end. | |
| 404 | PLIST may be a list of properties, PROPS are individual properties and values | |
| 405 | that will be added to PLIST. Returns the string that was modified." | |
| 406 | (add-text-properties | |
| 407 | 0 (length string) (if props (append plist props) plist) string) | |
| 408 | string) | |
| 409 | (put 'org-add-props 'lisp-indent-function 2) | |
| 410 | ||
| 411 | (defun org-fit-window-to-buffer (&optional window max-height min-height | |
| 412 | shrink-only) | |
| 413 | "Fit WINDOW to the buffer, but only if it is not a side-by-side window. | |
| 414 | WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are | |
| 415 | passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call | |
| 416 | `shrink-window-if-larger-than-buffer' instead, the height limit is | |
| 417 | ignored in this case." | |
| 418 | (cond ((if (fboundp 'window-full-width-p) | |
| 419 | (not (window-full-width-p window)) | |
| 420 | ;; do nothing if another window would suffer | |
| 421 | (> (frame-width) (window-width window)))) | |
| 422 | ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) | |
| 423 | (fit-window-to-buffer window max-height min-height)) | |
| 424 | ((fboundp 'shrink-window-if-larger-than-buffer) | |
| 425 | (shrink-window-if-larger-than-buffer window))) | |
| 426 | (or window (selected-window))) | |
| 427 | ||
| 428 | ;; `set-transient-map' is only in Emacs >= 24.4 | |
| 429 | (defalias 'org-set-transient-map | |
| 430 | (if (fboundp 'set-transient-map) | |
| 431 | 'set-transient-map | |
| 432 | 'set-temporary-overlay-map)) | |
| 433 | ||
| 434 | ;;; Region compatibility | |
| 435 | ||
| 436 | (defvar org-ignore-region nil | |
| 437 | "Non-nil means temporarily disable the active region.") | |
| 438 | ||
| 439 | (defun org-region-active-p () | |
| 440 | "Non-nil when the region active. | |
| 441 | Unlike to `use-region-p', this function also checks | |
| 442 | `org-ignore-region'." | |
| 443 | (and (not org-ignore-region) (use-region-p))) | |
| 444 | ||
| 445 | (defun org-cursor-to-region-beginning () | |
| 446 | (when (and (org-region-active-p) | |
| 447 | (> (point) (region-beginning))) | |
| 448 | (exchange-point-and-mark))) | |
| 449 | ||
| 450 | ;;; Invisibility compatibility | |
| 451 | ||
| 452 | (defun org-remove-from-invisibility-spec (arg) | |
| 453 | "Remove elements from `buffer-invisibility-spec'." | |
| 454 | (if (fboundp 'remove-from-invisibility-spec) | |
| 455 | (remove-from-invisibility-spec arg) | |
| 456 | (if (consp buffer-invisibility-spec) | |
| 457 | (setq buffer-invisibility-spec | |
| 458 | (delete arg buffer-invisibility-spec))))) | |
| 459 | ||
| 460 | (defun org-in-invisibility-spec-p (arg) | |
| 461 | "Is ARG a member of `buffer-invisibility-spec'?" | |
| 462 | (if (consp buffer-invisibility-spec) | |
| 463 | (member arg buffer-invisibility-spec))) | |
| 464 | ||
| 465 | (defun org-move-to-column (column &optional force _buffer) | |
| 466 | "Move to column COLUMN. | |
| 467 | Pass COLUMN and FORCE to `move-to-column'." | |
| 468 | (let ((buffer-invisibility-spec | |
| 469 | (if (listp buffer-invisibility-spec) | |
| 470 | (remove '(org-filtered) buffer-invisibility-spec) | |
| 471 | buffer-invisibility-spec))) | |
| 472 | (move-to-column column force))) | |
| 473 | ||
| 474 | (defmacro org-find-library-dir (library) | |
| 475 | `(file-name-directory (or (locate-library ,library) ""))) | |
| 476 | ||
| 477 | (defun org-count-lines (s) | |
| 478 | "How many lines in string S?" | |
| 479 | (let ((start 0) (n 1)) | |
| 480 | (while (string-match "\n" s start) | |
| 481 | (setq start (match-end 0) n (1+ n))) | |
| 482 | (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n)) | |
| 483 | (setq n (1- n))) | |
| 484 | n)) | |
| 485 | ||
| 486 | (defun org-kill-new (string &rest args) | |
| 487 | (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t) | |
| 488 | string) | |
| 489 | (apply 'kill-new string args)) | |
| 490 | ||
| 491 | ;; `font-lock-ensure' is only available from 24.4.50 on | |
| 492 | (defalias 'org-font-lock-ensure | |
| 493 | (if (fboundp 'font-lock-ensure) | |
| 494 | #'font-lock-ensure | |
| 495 | (lambda (&optional _beg _end) | |
| 496 | (with-no-warnings (font-lock-fontify-buffer))))) | |
| 497 | ||
| 498 | ;; `file-local-name' was added in Emacs 26.1. | |
| 499 | (defalias 'org-babel-local-file-name | |
| 500 | (if (fboundp 'file-local-name) | |
| 501 | 'file-local-name | |
| 502 | (lambda (file) | |
| 503 | "Return the local name component of FILE." | |
| 504 | (or (file-remote-p file 'localname) file)))) | |
| 505 | ||
| 506 | (defmacro org-no-popups (&rest body) | |
| 507 | "Suppress popup windows. | |
| 508 | Let-bind some variables to nil around BODY to achieve the desired | |
| 509 | effect, which variables to use depends on the Emacs version." | |
| 510 | (if (org-version-check "24.2.50" "" :predicate) | |
| 511 | `(let (pop-up-frames display-buffer-alist) | |
| 512 | ,@body) | |
| 513 | `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) | |
| 514 | ,@body))) | |
| 515 | ||
| 516 | ;;;###autoload | |
| 517 | (defmacro org-check-version () | |
| 518 | "Try very hard to provide sensible version strings." | |
| 519 | (let* ((org-dir (org-find-library-dir "org")) | |
| 520 | (org-version.el (concat org-dir "org-version.el")) | |
| 521 | (org-fixup.el (concat org-dir "../mk/org-fixup.el"))) | |
| 522 | (if (require 'org-version org-version.el 'noerror) | |
| 523 | '(progn | |
| 524 | (autoload 'org-release "org-version.el") | |
| 525 | (autoload 'org-git-version "org-version.el")) | |
| 526 | (if (require 'org-fixup org-fixup.el 'noerror) | |
| 527 | '(org-fixup) | |
| 528 | ;; provide fallback definitions and complain | |
| 529 | (warn "Could not define org version correctly. Check installation!") | |
| 530 | '(progn | |
| 531 | (defun org-release () "N/A") | |
| 532 | (defun org-git-version () "N/A !!check installation!!")))))) | |
| 533 | ||
| 534 | (defmacro org-with-silent-modifications (&rest body) | |
| 535 | (if (fboundp 'with-silent-modifications) | |
| 536 | `(with-silent-modifications ,@body) | |
| 537 | `(org-unmodified ,@body))) | |
| 538 | (def-edebug-spec org-with-silent-modifications (body)) | |
| 539 | ||
| 540 | ;; Functions for Emacs < 24.4 compatibility | |
| 541 | (defun org-define-error (name message) | |
| 542 | "Define NAME as a new error signal. | |
| 543 | MESSAGE is a string that will be output to the echo area if such | |
| 544 | an error is signaled without being caught by a `condition-case'. | |
| 545 | Implements `define-error' for older emacsen." | |
| 546 | (if (fboundp 'define-error) (define-error name message) | |
| 547 | (put name 'error-conditions | |
| 548 | (copy-sequence (cons name (get 'error 'error-conditions)))))) | |
| 549 | ||
| 550 | (unless (fboundp 'string-suffix-p) | |
| 551 | ;; From Emacs subr.el. | |
| 552 | (defun string-suffix-p (suffix string &optional ignore-case) | |
| 553 | "Return non-nil if SUFFIX is a suffix of STRING. | |
| 554 | If IGNORE-CASE is non-nil, the comparison is done without paying | |
| 555 | attention to case differences." | |
| 556 | (let ((start-pos (- (length string) (length suffix)))) | |
| 557 | (and (>= start-pos 0) | |
| 558 | (eq t (compare-strings suffix nil nil | |
| 559 | string start-pos nil ignore-case)))))) | |
| 560 | ||
| 561 | (provide 'org-compat) | |
| 562 | ||
| 563 | ;;; org-compat.el ends here | |
