diff options
Diffstat (limited to 'lisp/org/org-compat.el')
| -rw-r--r-- | lisp/org/org-compat.el | 713 |
1 files changed, 329 insertions, 384 deletions
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 42e2271c076..e1d40369f19 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -1,4 +1,4 @@ -;;; org-compat.el --- Compatibility code for Org-mode +;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -24,65 +24,287 @@ ;; ;;; Commentary: -;; This file contains code needed for compatibility with XEmacs and older +;; This file contains code needed for compatibility with older ;; versions of GNU Emacs. ;;; Code: -(eval-when-compile - (require 'cl)) - +(require 'cl-lib) (require 'org-macs) -;; The following constant is for backward compatibility. We do not use -;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) -;; at compilation time and can therefore optimize code better. -(defconst org-xemacs-p (featurep 'xemacs)) -(defconst org-format-transports-properties-p - (let ((x "a")) - (add-text-properties 0 1 '(test t) x) - (get-text-property 0 'test (format "%s" x))) - "Does format transport text properties?") +(declare-function org-at-table.el-p "org" (&optional table-type)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-type "org-element" (element)) +(declare-function org-link-set-parameters "org" (type &rest rest)) +(declare-function org-table-end (&optional table-type)) +(declare-function table--at-cell-p "table" (position &optional object at-column)) + +(defvar org-table-any-border-regexp) +(defvar org-table-dataline-regexp) +(defvar org-table-tab-recognizes-table.el) +(defvar org-table1-hline-regexp) + +;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-' +;; prefix, `find-tag' is replaced with `xref-find-definition' and +;; `x-get-selection' with `gui-get-selection'. +(when (< emacs-major-version 25) + (defalias 'outline-hide-entry 'hide-entry) + (defalias 'outline-hide-sublevels 'hide-sublevels) + (defalias 'outline-hide-subtree 'hide-subtree) + (defalias 'outline-show-all 'show-all) + (defalias 'outline-show-branches 'show-branches) + (defalias 'outline-show-children 'show-children) + (defalias 'outline-show-entry 'show-entry) + (defalias 'outline-show-subtree 'show-subtree) + (defalias 'xref-find-definitions 'find-tag) + (defalias 'format-message 'format) + (defalias 'gui-get-selection 'x-get-selection)) + + +;;; Obsolete aliases (remove them after the next major release). + +;;;; XEmacs compatibility, now removed. +(define-obsolete-function-alias 'org-activate-mark 'activate-mark) +(define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0") +(define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0") +(define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0") +(define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0") +(define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0") +(define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0") +(define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0") +(define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0") +(define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0") +(define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0") +(define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0") +(define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0") +(define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0") +(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0") + +(defmacro org-re (s) + "Replace posix classes in regular expression S." + (declare (debug (form)) + (obsolete "you can safely remove it." "Org 9.0")) + s) + +;;;; Functions from cl-lib that Org used to have its own implementation of. +(define-obsolete-function-alias 'org-count 'cl-count "Org 9.0") +(define-obsolete-function-alias 'org-every 'cl-every "Org 9.0") +(define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0") +(define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0") +(define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0") +(define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0") +(define-obsolete-function-alias 'org-some 'cl-some "Org 9.0") +(define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0") + +(defun org-sublist (list start end) + "Return a section of LIST, from START to END. +Counting starts at 1." + (cl-subseq list (1- start) end)) +(make-obsolete 'org-sublist + "use cl-subseq (note the 0-based counting)." + "Org 9.0") + + +;;;; Functions available since Emacs 24.3 +(define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0") +(define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "Org 9.0") +(define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0") +(define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0") +(define-obsolete-function-alias 'org-format-seconds 'format-seconds "Org 9.0") +(define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "Org 9.0") +(define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "Org 9.0") +(define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0") +(define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0") +(define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0") + +;;;; Functions and variables from previous releases now obsolete. +(define-obsolete-function-alias 'org-element-remove-indentation + 'org-remove-indentation "Org 9.0") +(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics + 'org-checkbox-hierarchical-statistics "Org 8.0") +(define-obsolete-variable-alias 'org-description-max-indent + 'org-list-description-max-indent "Org 8.0") +(define-obsolete-variable-alias 'org-latex-create-formula-image-program + 'org-preview-latex-default-process "Org 9.0") +(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory + 'org-preview-latex-image-directory "Org 9.0") +(define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0") +(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0") +(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3") +(define-obsolete-function-alias 'org-speed-command-default-hook + 'org-speed-command-activate "Org 8.0") +(define-obsolete-function-alias 'org-babel-speed-command-hook + 'org-babel-speed-command-activate "Org 8.0") +(define-obsolete-function-alias 'org-image-file-name-regexp + 'image-file-name-regexp "Org 9.0") +(define-obsolete-function-alias 'org-get-legal-level + 'org-get-valid-level "Org 7.8") +(define-obsolete-function-alias 'org-completing-read-no-i + 'completing-read "Org 9.0") +(define-obsolete-function-alias 'org-icompleting-read + 'completing-read "Org 9.0") +(define-obsolete-function-alias 'org-iread-file-name 'read-file-name "Org 9.0") +(define-obsolete-function-alias 'org-days-to-time + 'org-time-stamp-to-now "Org 8.2") +(define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties + 'org-agenda-ignore-properties "Org 9.0") +(define-obsolete-function-alias 'org-preview-latex-fragment + 'org-toggle-latex-fragment "Org 8.3") +(define-obsolete-function-alias 'org-display-inline-modification-hook + 'org-display-inline-remove-overlay "Org 8.0") +(define-obsolete-function-alias 'org-export-get-genealogy + 'org-element-lineage "Org 9.0") +(define-obsolete-variable-alias 'org-latex-with-hyperref + 'org-latex-hyperref-template "Org 9.0") +(define-obsolete-variable-alias 'org-link-to-org-use-id + 'org-id-link-to-org-use-id "Org 8.0") +(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0") +(define-obsolete-variable-alias 'org-clock-modeline-total + 'org-clock-mode-line-total "Org 8.0") +(define-obsolete-function-alias 'org-protocol-unhex-compound + 'org-link-unescape-compound "Org 7.8") +(define-obsolete-function-alias 'org-protocol-unhex-string + 'org-link-unescape "Org 7.8") +(define-obsolete-function-alias 'org-protocol-unhex-single-byte-sequence + 'org-link-unescape-single-byte-sequence "Org 7.8") +(define-obsolete-variable-alias 'org-export-htmlized-org-css-url + 'org-org-htmlized-css-url "Org 8.2") +(define-obsolete-variable-alias 'org-alphabetical-lists + 'org-list-allow-alphabetical "Org 8.0") +(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0") +(define-obsolete-variable-alias 'org-agenda-menu-two-column + 'org-agenda-menu-two-columns "Org 8.0") +(define-obsolete-variable-alias 'org-finalize-agenda-hook + 'org-agenda-finalize-hook "Org 8.0") +(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "Org 7.8") +(define-obsolete-function-alias 'org-agenda-post-command-hook + 'org-agenda-update-agenda-type "Org 8.0") +(define-obsolete-function-alias 'org-agenda-todayp + 'org-agenda-today-p "Org 9.0") +(define-obsolete-function-alias 'org-babel-examplize-region + 'org-babel-examplify-region "Org 9.0") +(define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0") +(define-obsolete-variable-alias 'org-html-style-include-scripts + 'org-html-head-include-scripts "Org 8.0") +(define-obsolete-variable-alias 'org-html-style-include-default + 'org-html-head-include-default-style "Org 8.0") +(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") +(define-obsolete-function-alias 'org-insert-columns-dblock + 'org-columns-insert-dblock "Org 9.0") +(define-obsolete-function-alias 'org-activate-bracket-links + 'org-activate-links "Org 9.0") +(define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0") +(define-obsolete-function-alias 'org-activate-angle-links 'ignore "Org 9.0") + +(defun org-in-fixed-width-region-p () + "Non-nil if point in a fixed-width region." + (save-match-data + (eq 'fixed-width (org-element-type (org-element-at-point))))) +(make-obsolete 'org-in-fixed-width-region-p + "use `org-element' library" + "Org 9.0") + +(defcustom org-read-date-minibuffer-setup-hook nil + "Hook to be used to set up keys for the date/time interface. +Add key definitions to `minibuffer-local-map', which will be a +temporary copy." + :group 'org-time + :type 'hook) +(make-obsolete-variable + 'org-read-date-minibuffer-setup-hook + "set `org-read-date-minibuffer-local-map' instead." "Org 8.0") (defun org-compatible-face (inherits specs) "Make a compatible face specification. -If INHERITS is an existing face and if the Emacs version supports it, -just inherit the face. If INHERITS is set and the Emacs version does -not support it, copy the face specification from the inheritance face. -If INHERITS is not given and SPECS is, use SPECS to define the face. -XEmacs and Emacs 21 do not know about the `min-colors' attribute. -For them we convert a (min-colors 8) entry to a `tty' entry and move it -to the top of the list. The `min-colors' attribute will be removed from -any other entries, and any resulting duplicates will be removed entirely." - (when (and inherits (facep inherits) (not specs)) - (setq specs (or specs - (get inherits 'saved-face) - (get inherits 'face-defface-spec)))) - (cond - ((and inherits (facep inherits) - (not (featurep 'xemacs)) - (>= emacs-major-version 22) - ;; do not inherit outline faces before Emacs 23 - (or (>= emacs-major-version 23) - (not (string-match "\\`outline-[0-9]+" - (symbol-name inherits))))) - (list (list t :inherit inherits))) - ((or (featurep 'xemacs) (< emacs-major-version 22)) - ;; These do not understand the `min-colors' attribute. - (let (r e a) - (while (setq e (pop specs)) - (cond - ((memq (car e) '(t default)) (push e r)) - ((setq a (member '(min-colors 8) (car e))) - (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) - (cdr e))))) - ((setq a (assq 'min-colors (car e))) - (setq e (cons (delq a (car e)) (cdr e))) - (or (assoc (car e) r) (push e r))) - (t (or (assoc (car e) r) (push e r))))) - (nreverse r))) - (t specs))) -(put 'org-compatible-face 'lisp-indent-function 1) +If INHERITS is an existing face and if the Emacs version supports +it, just inherit the face. If INHERITS is not given and SPECS +is, use SPECS to define the face." + (declare (indent 1)) + (if (facep inherits) + (list (list t :inherit inherits)) + specs)) +(make-obsolete 'org-compatible-face "you can remove it." "Org 9.0") + +(defun org-add-link-type (type &optional follow export) + "Add a new TYPE link. +FOLLOW and EXPORT are two functions. + +FOLLOW should take the link path as the single argument and do whatever +is necessary to follow the link, for example find a file or display +a mail message. + +EXPORT should format the link path for export to one of the export formats. +It should be a function accepting three arguments: + + path the path of the link, the text after the prefix (like \"http:\") + desc the description of the link, if any + format the export format, a symbol like `html' or `latex' or `ascii'. + +The function may use the FORMAT information to return different values +depending on the format. The return value will be put literally into +the exported file. If the return value is nil, this means Org should +do what it normally does with links which do not have EXPORT defined. + +Org mode has a built-in default for exporting links. If you are happy with +this default, there is no need to define an export function for the link +type. For a simple example of an export function, see `org-bbdb.el'. + +If TYPE already exists, update it with the arguments. +See `org-link-parameters' for documentation on the other parameters." + (org-link-set-parameters type :follow follow :export export) + (message "Created %s link." type)) + +(make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0") + +(defun org-table-recognize-table.el () + "If there is a table.el table nearby, recognize it and move into it." + (when (and org-table-tab-recognizes-table.el (org-at-table.el-p)) + (beginning-of-line) + (unless (or (looking-at org-table-dataline-regexp) + (not (looking-at org-table1-hline-regexp))) + (forward-line) + (when (looking-at org-table-any-border-regexp) + (forward-line -2))) + (if (re-search-forward "|" (org-table-end t) t) + (progn + (require 'table) + (if (table--at-cell-p (point)) t + (message "recognizing table.el table...") + (table-recognize-table) + (message "recognizing table.el table...done"))) + (error "This should not happen")))) + +;; Not used by Org core since commit 6d1e3082, Feb 2010. +(make-obsolete 'org-table-recognize-table.el + "please notify the org mailing list if you use this function." + "Org 9.0") + +(define-obsolete-function-alias + 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string "Org 8.0") + +(defun org-remove-angle-brackets (s) + (org-unbracket-string "<" ">" s)) +(make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0") + +(defun org-remove-double-quotes (s) + (org-unbracket-string "\"" "\"" s)) +(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0") + +(define-obsolete-function-alias 'org-babel-number-p + 'org-babel--string-to-number "Org 9.0") + + + +;;;; Obsolete link types + +(eval-after-load 'org + '(progn + (org-link-set-parameters "file+emacs") ;since Org 9.0 + (org-link-set-parameters "file+sys"))) ;since Org 9.0 + + + +;;; Miscellaneous functions (defun org-version-check (version feature level) (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) @@ -108,110 +330,19 @@ any other entries, and any resulting duplicates will be removed entirely." t)) t))) - -;;;; Emacs/XEmacs compatibility - -(eval-and-compile - (defun org-defvaralias (new-alias base-variable &optional docstring) - "Compatibility function for defvaralias. -Don't do the aliasing when `defvaralias' is not bound." - (declare (indent 1)) - (when (fboundp 'defvaralias) - (defvaralias new-alias base-variable docstring))) - - (when (and (not (boundp 'user-emacs-directory)) - (boundp 'user-init-directory)) - (org-defvaralias 'user-emacs-directory 'user-init-directory))) - -(when (featurep 'xemacs) - (defadvice custom-handle-keyword - (around org-custom-handle-keyword - activate preactivate) - "Remove custom keywords not recognized to avoid producing an error." - (cond - ((eq (ad-get-arg 1) :package-version)) - (t ad-do-it))) - (defadvice define-obsolete-variable-alias - (around org-define-obsolete-variable-alias - (obsolete-name current-name &optional when docstring) - activate preactivate) - "Declare arguments defined in later versions of Emacs." - ad-do-it) - (defadvice define-obsolete-function-alias - (around org-define-obsolete-function-alias - (obsolete-name current-name &optional when docstring) - activate preactivate) - "Declare arguments defined in later versions of Emacs." - ad-do-it) - (defvar customize-package-emacs-version-alist nil) - (defvar temporary-file-directory (temp-directory))) - -;; Keys -(defconst org-xemacs-key-equivalents - '(([mouse-1] . [button1]) - ([mouse-2] . [button2]) - ([mouse-3] . [button3]) - ([C-mouse-4] . [(control mouse-4)]) - ([C-mouse-5] . [(control mouse-5)])) - "Translation alist for a couple of keys.") - -;; Overlay compatibility functions -(defun org-detach-overlay (ovl) - (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-overlay-display (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'invisible t) - (set-extent-property ovl 'end-glyph gl)) - (overlay-put ovl 'display text) - (if face (overlay-put ovl 'face face)) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-before-string (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'begin-glyph gl)) - (if face (org-add-props text nil 'face face)) - (overlay-put ovl 'before-string text) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-find-overlays (prop &optional pos delete) - "Find all overlays specifying PROP at POS or point. -If DELETE is non-nil, delete all those overlays." - (let ((overlays (overlays-at (or pos (point)))) - ov found) - (while (setq ov (pop overlays)) - (if (overlay-get ov prop) - (if delete (delete-overlay ov) (push ov found)))) - found)) - (defun org-get-x-clipboard (value) - "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21." - (cond ((eq window-system 'x) - (let ((x (org-get-x-clipboard-compat value))) - (if x (org-no-properties x)))) + "Get the value of the X or Windows clipboard." + (cond ((and (eq window-system 'x) + (fboundp 'gui-get-selection)) ;Silence byte-compiler. + (org-no-properties + (ignore-errors + (or (gui-get-selection value 'UTF8_STRING) + (gui-get-selection value 'COMPOUND_TEXT) + (gui-get-selection value 'STRING) + (gui-get-selection value 'TEXT))))) ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) (w32-get-clipboard-data)))) -(defsubst org-decompose-region (beg end) - "Decompose from BEG to END." - (if (featurep 'xemacs) - (let ((modified-p (buffer-modified-p)) - (buffer-read-only nil)) - (remove-text-properties beg end '(composition nil)) - (set-buffer-modified-p modified-p)) - (decompose-region beg end))) - -;; Miscellaneous functions - -(defun org-add-hook (hook function &optional append local) - "Add-hook, compatible with both Emacsen." - (if (and local (featurep 'xemacs)) - (add-local-hook hook function append) - (add-hook hook function append local))) - (defun org-add-props (string plist &rest props) "Add text properties to entire string, from beginning to end. PLIST may be a list of properties, PROPS are individual properties and values @@ -238,66 +369,29 @@ ignored in this case." (shrink-window-if-larger-than-buffer window))) (or window (selected-window))) -(defun org-number-sequence (from &optional to inc) - "Call `number-sequence' or emulate it." - (if (fboundp 'number-sequence) - (number-sequence from to inc) - (if (or (not to) (= from to)) - (list from) - (or inc (setq inc 1)) - (when (zerop inc) (error "The increment can not be zero")) - (let (seq (n 0) (next from)) - (if (> inc 0) - (while (<= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc)))) - (while (>= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc))))) - (nreverse seq))))) - ;; `set-transient-map' is only in Emacs >= 24.4 (defalias 'org-set-transient-map (if (fboundp 'set-transient-map) 'set-transient-map 'set-temporary-overlay-map)) -;; Region compatibility +;;; Region compatibility (defvar org-ignore-region nil "Non-nil means temporarily disable the active region.") (defun org-region-active-p () - "Is `transient-mark-mode' on and the region active? -Works on both Emacs and XEmacs." - (if org-ignore-region - nil - (if (featurep 'xemacs) - (and zmacs-regions (region-active-p)) - (if (fboundp 'use-region-p) - (use-region-p) - (and transient-mark-mode mark-active))))) ; Emacs 22 and before + "Non-nil when the region active. +Unlike to `use-region-p', this function also checks +`org-ignore-region'." + (and (not org-ignore-region) (use-region-p))) (defun org-cursor-to-region-beginning () (when (and (org-region-active-p) (> (point) (region-beginning))) (exchange-point-and-mark))) -;; Emacs 22 misses `activate-mark' -(if (fboundp 'activate-mark) - (defalias 'org-activate-mark 'activate-mark) - (defun org-activate-mark () - (when (mark t) - (setq mark-active t) - (when (and (boundp 'transient-mark-mode) - (not transient-mark-mode)) - (set (make-local-variable 'transient-mark-mode) 'lambda)) - (when (boundp 'zmacs-regions) - (setq zmacs-regions t))))) - -;; Invisibility compatibility +;;; Invisibility compatibility (defun org-remove-from-invisibility-spec (arg) "Remove elements from `buffer-invisibility-spec'." @@ -312,63 +406,14 @@ Works on both Emacs and XEmacs." (if (consp buffer-invisibility-spec) (member arg buffer-invisibility-spec))) -(defmacro org-xemacs-without-invisibility (&rest body) - "Turn off extents with invisibility while executing BODY." - `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - ,@body - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec))))) -(def-edebug-spec org-xemacs-without-invisibility (body)) - -(defun org-indent-to-column (column &optional minimum buffer) - "Work around a bug with extents with invisibility in XEmacs." - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) - (indent-to-column column minimum))) - -(defun org-indent-line-to (column) - "Work around a bug with extents with invisibility in XEmacs." - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (indent-line-to column)) - (indent-line-to column))) - -(defun org-move-to-column (column &optional force buffer) +(defun org-move-to-column (column &optional force _buffer) "Move to column COLUMN. -Pass COLUMN and FORCE to `move-to-column'. -Pass BUFFER to the XEmacs version of `move-to-column'." +Pass COLUMN and FORCE to `move-to-column'." (let ((buffer-invisibility-spec - (remove '(org-filtered) buffer-invisibility-spec))) - (if (featurep 'xemacs) - (org-xemacs-without-invisibility - (move-to-column column force buffer)) - (move-to-column column force)))) - -(defun org-get-x-clipboard-compat (value) - "Get the clipboard value on XEmacs or Emacs 21." - (cond ((featurep 'xemacs) - (org-no-warnings (get-selection-no-error value))) - ((fboundp 'x-get-selection) - (condition-case nil - (or (x-get-selection value 'UTF8_STRING) - (x-get-selection value 'COMPOUND_TEXT) - (x-get-selection value 'STRING) - (x-get-selection value 'TEXT)) - (error nil))))) - -(defun org-propertize (string &rest properties) - (if (featurep 'xemacs) - (progn - (add-text-properties 0 (length string) properties string) - string) - (apply 'propertize string properties))) + (if (listp buffer-invisibility-spec) + (remove '(org-filtered) buffer-invisibility-spec) + buffer-invisibility-spec))) + (move-to-column column force))) (defmacro org-find-library-dir (library) `(file-name-directory (or (locate-library ,library) ""))) @@ -387,37 +432,20 @@ Pass BUFFER to the XEmacs version of `move-to-column'." string) (apply 'kill-new string args)) -(defun org-select-frame-set-input-focus (frame) - "Select FRAME, raise it, and set input focus, if possible." - (cond ((featurep 'xemacs) - (if (fboundp 'select-frame-set-input-focus) - (select-frame-set-input-focus frame) - (raise-frame frame) - (select-frame frame) - (focus-frame frame))) - ;; `select-frame-set-input-focus' defined in Emacs 21 will not - ;; set the input focus. - ((>= emacs-major-version 22) - (select-frame-set-input-focus frame)) - (t - (raise-frame frame) - (select-frame frame) - (cond ((memq window-system '(x ns mac)) - (x-focus-frame frame)) - ((eq window-system 'w32) - (w32-focus-frame frame))) - (when focus-follows-mouse - (set-mouse-position frame (1- (frame-width frame)) 0))))) - -(define-obsolete-function-alias 'org-float-time 'float-time "26.1") - -;; `user-error' is only available from 24.3 on -(unless (fboundp 'user-error) - (defalias 'user-error 'error)) - -;; ‘format-message’ is available only from 25 on -(unless (fboundp 'format-message) - (defalias 'format-message 'format)) +;; `font-lock-ensure' is only available from 24.4.50 on +(defalias 'org-font-lock-ensure + (if (fboundp 'font-lock-ensure) + #'font-lock-ensure + (lambda (&optional _beg _end) + (with-no-warnings (font-lock-fontify-buffer))))) + +;; `file-local-name' was added in Emacs 26.1. +(defalias 'org-babel-local-file-name + (if (fboundp 'file-local-name) + 'file-local-name + (lambda (file) + "Return the local name component of FILE." + (or (file-remote-p file 'localname) file)))) (defmacro org-no-popups (&rest body) "Suppress popup windows. @@ -429,93 +457,6 @@ effect, which variables to use depends on the Emacs version." `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) ,@body))) -(if (fboundp 'string-match-p) - (defalias 'org-string-match-p 'string-match-p) - (defun org-string-match-p (regexp string &optional start) - (save-match-data - (funcall 'string-match regexp string start)))) - -(if (fboundp 'looking-at-p) - (defalias 'org-looking-at-p 'looking-at-p) - (defun org-looking-at-p (&rest args) - (save-match-data - (apply 'looking-at args)))) - -;; XEmacs does not have `looking-back'. -(if (fboundp 'looking-back) - (defalias 'org-looking-back 'looking-back) - (defun org-looking-back (regexp &optional limit greedy) - "Return non-nil if text before point matches regular expression REGEXP. -Like `looking-at' except matches before point, and is slower. -LIMIT if non-nil speeds up the search by specifying a minimum -starting position, to avoid checking matches that would start -before LIMIT. - -If GREEDY is non-nil, extend the match backwards as far as -possible, stopping when a single additional previous character -cannot be part of a match for REGEXP. When the match is -extended, its starting position is allowed to occur before -LIMIT." - (let ((start (point)) - (pos - (save-excursion - (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) - (point))))) - (if (and greedy pos) - (save-restriction - (narrow-to-region (point-min) start) - (while (and (> pos (point-min)) - (save-excursion - (goto-char pos) - (backward-char 1) - (looking-at (concat "\\(?:" regexp "\\)\\'")))) - (setq pos (1- pos))) - (save-excursion - (goto-char pos) - (looking-at (concat "\\(?:" regexp "\\)\\'"))))) - (not (null pos))))) - -(defalias 'org-font-lock-ensure - (if (fboundp 'font-lock-ensure) - #'font-lock-ensure - (lambda (&optional _beg _end) (font-lock-fontify-buffer)))) - -(defun org-floor* (x &optional y) - "Return a list of the floor of X and the fractional part of X. -With two arguments, return floor and remainder of their quotient." - (let ((q (floor x y))) - (list q (- x (if y (* y q) q))))) - -;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1. -(defun org-pop-to-buffer-same-window - (&optional buffer-or-name norecord label) - "Pop to buffer specified by BUFFER-OR-NAME in the selected window." - (if (fboundp 'pop-to-buffer-same-window) - (funcall - 'pop-to-buffer-same-window buffer-or-name norecord) - (funcall 'switch-to-buffer buffer-or-name norecord))) - -;; RECURSIVE has been introduced with Emacs 23.2. -;; This is copying and adapted from `tramp-compat-delete-directory' -(defun org-delete-directory (directory &optional recursive) - "Compatibility function for `delete-directory'." - (if (null recursive) - (delete-directory directory) - (condition-case nil - (funcall 'delete-directory directory recursive) - ;; This Emacs version does not support the RECURSIVE flag. We - ;; use the implementation from Emacs 23.2. - (wrong-number-of-arguments - (setq directory (directory-file-name (expand-file-name directory))) - (if (not (file-symlink-p directory)) - (mapc (lambda (file) - (if (eq t (car (file-attributes file))) - (org-delete-directory file recursive) - (delete-file file))) - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) - (delete-directory directory))))) - ;;;###autoload (defmacro org-check-version () "Try very hard to provide sensible version strings." @@ -534,29 +475,33 @@ With two arguments, return floor and remainder of their quotient." (defun org-release () "N/A") (defun org-git-version () "N/A !!check installation!!")))))) -(defun org-file-equal-p (f1 f2) - "Return t if files F1 and F2 are the same. -Implements `file-equal-p' for older emacsen and XEmacs." - (if (fboundp 'file-equal-p) - (file-equal-p f1 f2) - (let (f1-attr f2-attr) - (and (setq f1-attr (file-attributes (file-truename f1))) - (setq f2-attr (file-attributes (file-truename f2))) - (equal f1-attr f2-attr))))) - -;; `buffer-narrowed-p' is available for Emacs >=24.3 -(defun org-buffer-narrowed-p () - "Compatibility function for `buffer-narrowed-p'." - (if (fboundp 'buffer-narrowed-p) - (buffer-narrowed-p) - (/= (- (point-max) (point-min)) (buffer-size)))) - (defmacro org-with-silent-modifications (&rest body) (if (fboundp 'with-silent-modifications) `(with-silent-modifications ,@body) `(org-unmodified ,@body))) (def-edebug-spec org-with-silent-modifications (body)) +;; Functions for Emacs < 24.4 compatibility +(defun org-define-error (name message) + "Define NAME as a new error signal. +MESSAGE is a string that will be output to the echo area if such +an error is signaled without being caught by a `condition-case'. +Implements `define-error' for older emacsen." + (if (fboundp 'define-error) (define-error name message) + (put name 'error-conditions + (copy-sequence (cons name (get 'error 'error-conditions)))))) + +(unless (fboundp 'string-suffix-p) + ;; From Emacs subr.el. + (defun string-suffix-p (suffix string &optional ignore-case) + "Return non-nil if SUFFIX is a suffix of STRING. +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (let ((start-pos (- (length string) (length suffix)))) + (and (>= start-pos 0) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case)))))) + (provide 'org-compat) ;;; org-compat.el ends here |