branch: externals/compat
commit 494da3f7dcf92d2945c08af5dd4f657b853677a3
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Disallow :realname to equal compat--<name>
I plan to use the naming convention compat--<name> for the compat-funcall
and
compat-function macros in the future. Intentionally use ugly
compat--internal-*
names. I hope we can remove some of those.
---
compat-25.el | 10 +++++-----
compat-26.el | 26 ++++++++++++-------------
compat-27.el | 12 ++++++------
compat-28.el | 4 ++--
compat-29.el | 60 ++++++++++++++++++++++++++++-----------------------------
compat-macs.el | 5 +++++
compat-tests.el | 18 ++++++++---------
7 files changed, 70 insertions(+), 65 deletions(-)
diff --git a/compat-25.el b/compat-25.el
index 891ebfa67d..5398d59e4a 100644
--- a/compat-25.el
+++ b/compat-25.el
@@ -79,7 +79,7 @@ This implementation is equivalent to `format'."
(compat-defun directory-name-p (name)
"Return non-nil if NAME ends with a directory separator character."
- :realname compat--directory-name-p
+ :realname compat--internal-directory-name-p
(eq (eval-when-compile
(if (memq system-type '(cygwin windows-nt ms-dos))
?\\ ?/))
@@ -296,7 +296,7 @@ subdirectory is to be descended into).
If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
directories are followed. Note that this can lead to infinite
recursion."
- :realname compat--directory-files-recursively
+ :realname compat--internal-directory-files-recursively
(let* ((result nil)
(files nil)
(dir (directory-file-name dir))
@@ -306,7 +306,7 @@ recursion."
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
- (if (compat--directory-name-p file)
+ (if (compat--internal-directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (concat dir "/" leaf)))
;; Don't follow symlinks to other directories.
@@ -320,11 +320,11 @@ recursion."
(let ((sub-files
(if (eq predicate t)
(condition-case nil
- (compat--directory-files-recursively
+ (compat--internal-directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks)
(file-error nil))
- (compat--directory-files-recursively
+ (compat--internal-directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks))))
(setq result (nconc result sub-files))))
diff --git a/compat-26.el b/compat-26.el
index bded43b32f..bd97b7d34a 100644
--- a/compat-26.el
+++ b/compat-26.el
@@ -44,14 +44,14 @@ FUNC must be a function of some kind.
The returned value is a cons cell (MIN . MAX). MIN is the minimum number
of args. MAX is the maximum number, or the symbol `many', for a
function with `&rest' args, or `unevalled' for a special form."
- :realname compat--func-arity
+ :realname compat--internal-func-arity
(cond
((or (null func) (and (symbolp func) (not (fboundp func))))
(signal 'void-function func))
((and (symbolp func) (not (null func)))
- (compat--func-arity (symbol-function func)))
+ (compat--internal-func-arity (symbol-function func)))
((eq (car-safe func) 'macro)
- (compat--func-arity (cdr func)))
+ (compat--internal-func-arity (cdr func)))
((subrp func)
(subr-arity func))
((memq (car-safe func) '(closure lambda))
@@ -106,7 +106,7 @@ function with `&rest' args, or `unevalled' for a special
form."
(cons mandatory (if arglist 'many nonrest))))
((autoloadp func)
(autoload-do-load func)
- (compat--func-arity func))
+ (compat--internal-func-arity func))
((signal 'invalid-function func))))
;;;; Defined in fns.c
@@ -192,7 +192,7 @@ from the absolute start of the buffer, disregarding the
narrowing."
"Trim STRING of leading string matching REGEXP.
REGEXP defaults to \"[ \\t\\n\\r]+\"."
- :realname compat--string-trim-left
+ :realname compat--internal-string-trim-left
:prefix t
(if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
(substring string (match-end 0))
@@ -202,7 +202,7 @@ REGEXP defaults to \"[ \\t\\n\\r]+\"."
"Trim STRING of trailing string matching REGEXP.
REGEXP defaults to \"[ \\t\\n\\r]+\"."
- :realname compat--string-trim-right
+ :realname compat--internal-string-trim-right
:prefix t
(let ((i (string-match-p
(concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
@@ -217,8 +217,8 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
;; `string-trim-left' and `string-trim-right' were moved from subr-x
;; to subr in Emacs 27, so to avoid loading subr-x we use the
;; compatibility function here:
- (compat--string-trim-left
- (compat--string-trim-right
+ (compat--internal-string-trim-left
+ (compat--internal-string-trim-right
string
trim-right)
trim-left))
@@ -445,15 +445,15 @@ and the method of accessing the host, leaving only the
part that
identifies FILE locally on the remote system.
The returned file name can be used directly as argument of
`process-file', `start-file-process', or `shell-command'."
- :realname compat--file-local-name
+ :realname compat--internal-file-local-name
(or (file-remote-p file 'localname) file))
(compat-defun file-name-quoted-p (name &optional top)
"Whether NAME is quoted with prefix \"/:\".
If NAME is a remote file name and TOP is nil, check the local part of NAME."
- :realname compat--file-name-quoted-p
+ :realname compat--internal-file-name-quoted-p
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
- (string-prefix-p "/:" (compat--file-local-name name))))
+ (string-prefix-p "/:" (compat--internal-file-local-name name))))
(compat-defun file-name-quote (name &optional top)
"Add the quotation prefix \"/:\" to file NAME.
@@ -461,9 +461,9 @@ If NAME is a remote file name and TOP is nil, the local
part of
NAME is quoted. If NAME is already a quoted file name, NAME is
returned unchanged."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
- (if (compat--file-name-quoted-p name top)
+ (if (compat--internal-file-name-quoted-p name top)
name
- (concat (file-remote-p name) "/:" (compat--file-local-name name)))))
+ (concat (file-remote-p name) "/:" (compat--internal-file-local-name
name)))))
;;* UNTESTED
(compat-defun temporary-file-directory ()
diff --git a/compat-27.el b/compat-27.el
index 43d9897dfc..a57618b3e2 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -174,7 +174,7 @@ any JSON false values."
(:success t)
(void-function nil)
(json-unavailable nil)))
- :realname compat--json-serialize
+ :realname compat--internal-json-serialize
(require 'json)
(letrec ((fix (lambda (obj)
(cond
@@ -235,7 +235,7 @@ OBJECT."
(:success t)
(void-function nil)
(json-unavailable nil)))
- (insert (apply #'compat--json-serialize object args)))
+ (insert (apply #'compat--internal-json-serialize object args)))
(compat-defun json-parse-string (string &rest args)
"Parse the JSON STRING into a Lisp object.
@@ -395,7 +395,7 @@ where USER is a valid login name."
"Non-nil if MODE is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards.
If you just want to check `major-mode', use `derived-mode-p'."
- :realname compat--provided-mode-derived-p
+ :realname compat--internal-provided-mode-derived-p
;; If MODE is an alias, then look up the real mode function first.
(let ((alias (symbol-function mode)))
(when (and alias (symbolp alias))
@@ -412,7 +412,7 @@ If you just want to check `major-mode', use
`derived-mode-p'."
(compat-defun derived-mode-p (&rest modes)
"Non-nil if the current major mode is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards."
- (apply #'compat--provided-mode-derived-p major-mode modes))
+ (apply #'compat--internal-provided-mode-derived-p major-mode modes))
;;* UNTESTED
(compat-defmacro ignore-error (condition &rest body)
@@ -603,7 +603,7 @@ The remote host is identified by `default-directory'. For
remote
hosts that do not support subprocesses, this returns nil.
If `default-directory' is a local directory, this function returns
the value of the variable `exec-path'."
- :realname compat--exec-path
+ :realname compat--internal-exec-path
(cond
((let ((handler (find-file-name-handler default-directory 'exec-path)))
;; FIXME: The handler was added in 27.1, and this compatibility
@@ -643,7 +643,7 @@ REMOTE is non-nil, search on the remote host indicated by
(mapcar
(apply-partially
#'concat (file-remote-p default-directory))
- (compat--exec-path))
+ (compat--internal-exec-path))
exec-suffixes 'file-executable-p)))
(when (stringp res) (compat--file-local-name res)))
(executable-find command)))
diff --git a/compat-28.el b/compat-28.el
index c7316bd703..47febbec4b 100644
--- a/compat-28.el
+++ b/compat-28.el
@@ -617,13 +617,13 @@ Errors if the FILENAME or EXTENSION are empty, or if the
given
FILENAME has the format of a directory.
See also `file-name-sans-extension'."
- (let ((extn (compat--string-trim-left extension "[.]")))
+ (let ((extn (compat--internal-string-trim-left extension "[.]")))
(cond
((string= filename "")
(error "Empty filename"))
((string= extn "")
(error "Malformed extension: %s" extension))
- ((compat--directory-name-p filename)
+ ((compat--internal-directory-name-p filename)
(error "Filename is a directory: %s" filename))
(t
(concat (file-name-sans-extension filename) "." extn)))))
diff --git a/compat-29.el b/compat-29.el
index 1680a92fe3..2389ff9ee4 100644
--- a/compat-29.el
+++ b/compat-29.el
@@ -80,7 +80,7 @@ Do not use this function if the buffer specified by
BUFFER-OR-NAME is
already displayed in WINDOW. `window-text-pixel-size' is cheaper in
that case because it does not have to temporarily show that buffer in
WINDOW."
- :realname compat--buffer-text-pixel-size
+ :realname compat--internal-buffer-text-pixel-size
(setq buffer-or-name (or buffer-or-name (current-buffer)))
(setq window (or window (selected-window)))
(save-window-excursion
@@ -286,7 +286,7 @@ CONDITION is either:
to be met.
* `or': the cdr is a list of recursive condition, of which at
least one has to be met."
- :realname compat--buffer-match-p
+ :realname compat--internal-buffer-match-p
(letrec
((buffer (get-buffer buffer-or-name))
(match
@@ -298,7 +298,7 @@ CONDITION is either:
((stringp condition)
(string-match-p condition (buffer-name buffer)))
((functionp condition)
- (if (eq 1 (cdr (compat--func-arity condition)))
+ (if (eq 1 (cdr (compat--internal-func-arity condition)))
(funcall condition buffer)
(funcall condition buffer arg)))
((eq (car-safe condition) 'major-mode)
@@ -306,7 +306,7 @@ CONDITION is either:
(buffer-local-value 'major-mode buffer)
(cdr condition)))
((eq (car-safe condition) 'derived-mode)
- (compat--provided-mode-derived-p
+ (compat--internal-provided-mode-derived-p
(buffer-local-value 'major-mode buffer)
(cdr condition)))
((eq (car-safe condition) 'not)
@@ -332,7 +332,7 @@ ARG is passed to `buffer-match', for predicate conditions in
CONDITION."
(let (bufs)
(dolist (buf (or buffers (buffer-list)))
- (when (compat--buffer-match-p condition (get-buffer buf) arg)
+ (when (compat--internal-buffer-match-p condition (get-buffer buf) arg)
(push buf bufs)))
bufs))
@@ -394,7 +394,7 @@ than this function."
(with-current-buffer (get-buffer-create " *string-pixel-width*")
(delete-region (point-min) (point-max))
(insert string)
- (car (compat--buffer-text-pixel-size nil nil t)))))
+ (car (compat--internal-buffer-text-pixel-size nil nil t)))))
;;* UNTESTED
(compat-defmacro with-buffer-unmodified-if-unchanged (&rest body)
@@ -573,7 +573,7 @@ Modifiers have to be specified in this order:
which is
Alt-Control-Hyper-Meta-Shift-super"
- :realname compat--key-valid-p
+ :realname compat--internal-key-valid-p
(declare (pure t) (side-effect-free t))
(let ((case-fold-search nil))
(and
@@ -611,7 +611,7 @@ which is
(compat-defun key-parse (keys)
"Convert KEYS to the internal Emacs key representation.
See `kbd' for a descripion of KEYS."
- :realname compat--key-parse
+ :realname compat--internal-key-parse
(declare (pure t) (side-effect-free t))
;; A pure function is expected to preserve the match data.
(save-match-data
@@ -721,16 +721,16 @@ DEFINITION is anything that can be a key's definition:
or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
or an extended menu item definition.
(See info node `(elisp)Extended Menu Items'.)"
- :realname compat--keymap-set
- (unless (compat--key-valid-p key)
+ :realname compat--internal-keymap-set
+ (unless (compat--internal-key-valid-p key)
(error "%S is not a valid key definition; see `key-valid-p'" key))
;; If we're binding this key to another key, then parse that other
;; key, too.
(when (stringp definition)
- (unless (compat--key-valid-p key)
+ (unless (compat--internal-key-valid-p key)
(error "%S is not a valid key definition; see `key-valid-p'" key))
- (setq definition (compat--key-parse definition)))
- (define-key keymap (compat--key-parse key) definition))
+ (setq definition (compat--internal-key-parse definition)))
+ (define-key keymap (compat--internal-key-parse key) definition))
;;* UNTESTED
(compat-defun keymap-unset (keymap key &optional remove)
@@ -742,10 +742,10 @@ makes a difference when there's a parent keymap. When
unsetting
a key in a child map, it will still shadow the same key in the
parent keymap. Removing the binding will allow the key in the
parent keymap to be used."
- :realname compat--keymap-unset
- (unless (compat--key-valid-p key)
+ :realname compat--internal-keymap-unset
+ (unless (compat--internal-key-valid-p key)
(error "%S is not a valid key definition; see `key-valid-p'" key))
- (compat--define-key-with-remove keymap (compat--key-parse key) nil remove))
+ (compat--define-key-with-remove keymap (compat--internal-key-parse key) nil
remove))
;;* UNTESTED
(compat-defun keymap-global-set (key command)
@@ -760,7 +760,7 @@ that local binding will continue to shadow any global
binding
that you make with this function.
NOTE: The compatibility version is not a command."
- (compat--keymap-set (current-global-map) key command))
+ (compat--internal-keymap-set (current-global-map) key command))
;;* UNTESTED
(compat-defun keymap-local-set (key command)
@@ -777,7 +777,7 @@ NOTE: The compatibility version is not a command."
(let ((map (current-local-map)))
(unless map
(use-local-map (setq map (make-sparse-keymap))))
- (compat--keymap-set map key command)))
+ (compat--internal-keymap-set map key command)))
;;* UNTESTED
(compat-defun keymap-global-unset (key &optional remove)
@@ -788,7 +788,7 @@ If REMOVE (interactively, the prefix arg), remove the
binding
instead of unsetting it. See `keymap-unset' for details.
NOTE: The compatibility version is not a command."
- (compat--keymap-unset (current-global-map) key remove))
+ (compat--internal-keymap-unset (current-global-map) key remove))
;;* UNTESTED
(compat-defun keymap-local-unset (key &optional remove)
@@ -800,7 +800,7 @@ instead of unsetting it. See `keymap-unset' for details.
NOTE: The compatibility version is not a command."
(when (current-local-map)
- (compat--keymap-unset (current-local-map) key remove)))
+ (compat--internal-keymap-unset (current-local-map) key remove)))
;;* UNTESTED
(compat-defun keymap-substitute (keymap olddef newdef &optional oldmap prefix)
@@ -849,13 +849,13 @@ Bindings are always added before any inherited map.
The order of bindings in a keymap matters only when it is used as
a menu, so this function is not useful for non-menu keymaps."
- (unless (compat--key-valid-p key)
+ (unless (compat--internal-key-valid-p key)
(error "%S is not a valid key definition; see `key-valid-p'" key))
(when after
- (unless (compat--key-valid-p key)
+ (unless (compat--internal-key-valid-p key)
(error "%S is not a valid key definition; see `key-valid-p'" key)))
- (define-key-after keymap (compat--key-parse key) definition
- (and after (compat--key-parse after))))
+ (define-key-after keymap (compat--internal-key-parse key) definition
+ (and after (compat--internal-key-parse after))))
(compat-defun keymap-lookup
(keymap key &optional accept-default no-remap position)
@@ -890,13 +890,13 @@ position as returned by `event-start' and `event-end',
and the lookup
occurs in the keymaps associated with it instead of KEY. It can also
be a number or marker, in which case the keymap properties at the
specified buffer position instead of point are used."
- :realname compat--keymap-lookup
- (unless (compat--key-valid-p key)
+ :realname compat--internal-keymap-lookup
+ (unless (compat--internal-key-valid-p key)
(error "%S is not a valid key definition; see `key-valid-p'" key))
(when (and keymap position)
(error "Can't pass in both keymap and position"))
(if keymap
- (let ((value (lookup-key keymap (compat--key-parse key) accept-default)))
+ (let ((value (lookup-key keymap (compat--internal-key-parse key)
accept-default)))
(if (and (not no-remap)
(symbolp value))
(or (command-remapping value) value)
@@ -915,7 +915,7 @@ bindings; see the description of `keymap-lookup' for more
details
about this."
(let ((map (current-local-map)))
(when map
- (compat--keymap-lookup map keys accept-default))))
+ (compat--internal-keymap-lookup map keys accept-default))))
;;* UNTESTED
(compat-defun keymap-global-lookup (keys &optional accept-default _message)
@@ -931,7 +931,7 @@ bindings; see the description of `keymap-lookup' for more
details
about this.
NOTE: The compatibility version is not a command."
- (compat--keymap-lookup (current-global-map) keys accept-default))
+ (compat--internal-keymap-lookup (current-global-map) keys accept-default))
;;* UNTESTED
(compat-defun define-keymap (&rest definitions)
@@ -1010,7 +1010,7 @@ should be a MENU form as accepted by `easy-menu-define'.
(let ((def (pop definitions)))
(if (eq key :menu)
(easy-menu-define nil keymap "" def)
- (compat--keymap-set keymap key def)))))
+ (compat--internal-keymap-set keymap key def)))))
keymap)))
;;* UNTESTED
diff --git a/compat-macs.el b/compat-macs.el
index c45fd7671a..4279df6b9c 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -136,6 +136,11 @@ attributes (see `compat--generate-function')."
(when (version<= emacs-version "25")
(delq (assq 'side-effect-free (car body)) (car body))
(delq (assq 'pure (car body)) (car body))))
+ ;; Ensure that :realname is not the same as compat--<name>,
+ ;; since this is the compat-funcall/compat-function naming convention.
+ (when (and (plist-get rest :realname)
+ (string= (plist-get rest :realname) (format "compat--%s" name)))
+ (error "%s: :realname must not be the same as compat--<name>" name))
;; Check if we want an explicitly prefixed function
(when (plist-get rest :prefix)
(setq name (intern (format "compat-%s" name))))
diff --git a/compat-tests.el b/compat-tests.el
index 9555d2bb19..0c59a88746 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1272,29 +1272,29 @@ being compared against."
(should (equal (buffer-string) "{\":key\":[\"abc\",2],\"yek\":true}"))))
(ert-deftest compat-json-serialize ()
- "Check if `compat--json-serialize' was implemented properly."
+ "Check if `compat--internal-json-serialize' was implemented properly."
(let ((input-1 '((:key . ["abc" 2]) (yek . t)))
(input-2 '(:key ["abc" 2] yek t))
(input-3 (let ((ht (make-hash-table)))
(puthash "key" ["abc" 2] ht)
(puthash "yek" t ht)
ht)))
- (should (equal (compat--json-serialize input-1)
+ (should (equal (compat--internal-json-serialize input-1)
"{\":key\":[\"abc\",2],\"yek\":true}"))
- (should (equal (compat--json-serialize input-2)
+ (should (equal (compat--internal-json-serialize input-2)
"{\"key\":[\"abc\",2],\"yek\":true}"))
- (should (member (compat--json-serialize input-2)
+ (should (member (compat--internal-json-serialize input-2)
'("{\"key\":[\"abc\",2],\"yek\":true}"
"{\"yek\":true,\"key\":[\"abc\",2]}")))
- (should-error (compat--json-serialize '(("a" . 1)))
+ (should-error (compat--internal-json-serialize '(("a" . 1)))
:type '(wrong-type-argument symbolp "a"))
- (should-error (compat--json-serialize '("a" 1))
+ (should-error (compat--internal-json-serialize '("a" 1))
:type '(wrong-type-argument symbolp "a"))
- (should-error (compat--json-serialize '("a" 1 2))
+ (should-error (compat--internal-json-serialize '("a" 1 2))
:type '(wrong-type-argument symbolp "a"))
- (should-error (compat--json-serialize '(:a 1 2))
+ (should-error (compat--internal-json-serialize '(:a 1 2))
:type '(wrong-type-argument consp nil))
- (should-error (compat--json-serialize
+ (should-error (compat--internal-json-serialize
(let ((ht (make-hash-table)))
(puthash 'a 1 ht)
ht))
