X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6ccc848cd85e75d77d6b11a46f5f23f860db9ff5..123ddec7f807f4bd7400bbbe08219afb02269c00:/lisp/org/org-compat.el diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 6e582b8c1d..122658970f 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -1,6 +1,6 @@ ;;; org-compat.el --- Compatibility code for Org-mode -;; Copyright (C) 2004-2012 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -113,6 +113,41 @@ any other entries, and any resulting duplicates will be removed entirely." ;;;; 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]) @@ -155,10 +190,12 @@ If DELETE is non-nil, delete all those overlays." found)) (defun org-get-x-clipboard (value) - "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." - (if (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, 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)))) + ((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." @@ -195,9 +232,8 @@ passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call ignored in this case." (cond ((if (fboundp 'window-full-width-p) (not (window-full-width-p window)) - (> (frame-width) (window-width window))) - ;; do nothing if another window would suffer - ) + ;; do nothing if another window would suffer + (> (frame-width) (window-width window)))) ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) (fit-window-to-buffer window max-height min-height)) ((fboundp 'shrink-window-if-larger-than-buffer) @@ -224,10 +260,16 @@ ignored in this case." 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 (defvar org-ignore-region nil - "To temporarily disable the active region.") + "Non-nil means temporarily disable the active region.") (defun org-region-active-p () "Is `transient-mark-mode' on and the region active? @@ -253,11 +295,10 @@ Works on both Emacs and XEmacs." (setq mark-active t) (when (and (boundp 'transient-mark-mode) (not transient-mark-mode)) - (setq transient-mark-mode 'lambda)) + (set (make-local-variable 'transient-mark-mode) 'lambda)) (when (boundp 'zmacs-regions) (setq zmacs-regions t))))) - ;; Invisibility compatibility (defun org-remove-from-invisibility-spec (arg) @@ -271,8 +312,7 @@ Works on both Emacs and XEmacs." (defun org-in-invisibility-spec-p (arg) "Is ARG a member of `buffer-invisibility-spec'?" (if (consp buffer-invisibility-spec) - (member arg buffer-invisibility-spec) - nil)) + (member arg buffer-invisibility-spec))) (defmacro org-xemacs-without-invisibility (&rest body) "Turn off extents with invisibility while executing BODY." @@ -303,9 +343,15 @@ Works on both Emacs and XEmacs." (indent-line-to column))) (defun org-move-to-column (column &optional force buffer) - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (move-to-column column force buffer)) - (move-to-column column force))) + "Move to column COLUMN. +Pass COLUMN and FORCE to `move-to-column'. +Pass BUFFER to the XEmacs version of `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." @@ -365,12 +411,24 @@ Works on both Emacs and XEmacs." (when focus-follows-mouse (set-mouse-position frame (1- (frame-width frame)) 0))))) -(defun org-float-time (&optional time) +(defalias 'org-float-time + (if (featurep 'xemacs) 'time-to-seconds 'float-time) "Convert time value TIME to a floating point number. -TIME defaults to the current time." - (if (featurep 'xemacs) - (time-to-seconds (or time (current-time))) - (float-time time))) +TIME defaults to the current time.") + +;; `user-error' is only available from 24.2.50 on +(unless (fboundp 'user-error) + (defalias 'user-error 'error)) + +(defmacro org-no-popups (&rest body) + "Suppress popup windows. +Let-bind some variables to nil around BODY to achieve the desired +effect, which variables to use depends on the Emacs version." + (if (org-version-check "24.2.50" "" :predicate) + `(let (pop-up-frames display-buffer-alist) + ,@body) + `(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) @@ -384,7 +442,7 @@ TIME defaults to the current time." (save-match-data (apply 'looking-at args)))) - ; XEmacs does not have `looking-back'. +;; XEmacs does not have `looking-back'. (if (fboundp 'looking-back) (defalias 'org-looking-back 'looking-back) (defun org-looking-back (regexp &optional limit greedy) @@ -418,6 +476,11 @@ LIMIT." (looking-at (concat "\\(?:" regexp "\\)\\'"))))) (not (null pos))))) +(defalias 'org-font-lock-ensure + (if (fboundp 'org-font-lock-ensure) + #'font-lock-ensure + (lambda (_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." @@ -433,14 +496,26 @@ With two arguments, return floor and remainder of their quotient." 'pop-to-buffer-same-window buffer-or-name norecord) (funcall 'switch-to-buffer buffer-or-name norecord))) -;; `condition-case-unless-debug' has been introduced in Emacs 24.1 -;; `condition-case-no-debug' has been introduced in Emacs 23.1 -(defalias 'org-condition-case-unless-debug - (or (and (fboundp 'condition-case-unless-debug) - 'condition-case-unless-debug) - (and (fboundp 'condition-case-no-debug) - 'condition-case-no-debug) - 'condition-case)) +;; 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 () @@ -460,6 +535,29 @@ 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)) + (provide 'org-compat) ;;; org-compat.el ends here