[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 45d42f8: Use lexical-binding in apropos.el and add tests
From: |
Simen Heggest�yl |
Subject: |
master 45d42f8: Use lexical-binding in apropos.el and add tests |
Date: |
Sat, 18 Apr 2020 12:55:13 -0400 (EDT) |
branch: master
commit 45d42f81621743a96f209102464432ef2f230b0f
Author: Simen Heggestøyl <address@hidden>
Commit: Simen Heggestøyl <address@hidden>
Use lexical-binding in apropos.el and add tests
* lisp/apropos.el: Use lexical-binding and remove redundant
:group args.
(apropos-words-to-regexp, apropos): Tweak docstrings.
(apropos-value-internal): Replace '(if x (progn y))' with
'(when x y)'.
(apropos-format-plist): Add docstring and replace '(if x (progn y))'
with '(when x y)'.
* test/lisp/apropos-tests.el: New file with tests for apropos.el.
---
lisp/apropos.el | 52 +++++++-----------
test/lisp/apropos-tests.el | 133 +++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 154 insertions(+), 31 deletions(-)
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 7277319..e40f94c 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,4 +1,4 @@
-;;; apropos.el --- apropos commands for users and programmers
+;;; apropos.el --- apropos commands for users and programmers -*-
lexical-binding: t -*-
;; Copyright (C) 1989, 1994-1995, 2001-2020 Free Software Foundation,
;; Inc.
@@ -82,49 +82,41 @@ commands also has an optional argument to request a more
extensive search.
Additionally, this option makes the function `apropos-library'
include key-binding information in its output."
- :group 'apropos
:type 'boolean)
(defface apropos-symbol
'((t (:inherit bold)))
"Face for the symbol name in Apropos output."
- :group 'apropos
:version "24.3")
(defface apropos-keybinding
'((t (:inherit underline)))
"Face for lists of keybinding in Apropos output."
- :group 'apropos
:version "24.3")
(defface apropos-property
'((t (:inherit font-lock-builtin-face)))
"Face for property name in Apropos output, or nil for none."
- :group 'apropos
:version "24.3")
(defface apropos-function-button
'((t (:inherit (font-lock-function-name-face button))))
"Button face indicating a function, macro, or command in Apropos."
- :group 'apropos
:version "24.3")
(defface apropos-variable-button
'((t (:inherit (font-lock-variable-name-face button))))
"Button face indicating a variable in Apropos."
- :group 'apropos
:version "24.3")
(defface apropos-user-option-button
'((t (:inherit (font-lock-variable-name-face button))))
"Button face indicating a user option in Apropos."
- :group 'apropos
:version "24.4")
(defface apropos-misc-button
'((t (:inherit (font-lock-constant-face button))))
"Button face indicating a miscellaneous object type in Apropos."
- :group 'apropos
:version "24.3")
(defcustom apropos-match-face 'match
@@ -132,14 +124,12 @@ include key-binding information in its output."
This applies when you look for matches in the documentation or variable value
for the pattern; the part that matches gets displayed in this font."
:type '(choice (const nil) face)
- :group 'apropos
:version "24.3")
(defcustom apropos-sort-by-scores nil
"Non-nil means sort matches by scores; best match is shown first.
This applies to all `apropos' commands except `apropos-documentation'.
If value is `verbose', the computed score is shown for each match."
- :group 'apropos
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(const :tag "show scores" verbose)))
@@ -148,7 +138,6 @@ If value is `verbose', the computed score is shown for each
match."
"Non-nil means sort matches by scores; best match is shown first.
This applies to `apropos-documentation' only.
If value is `verbose', the computed score is shown for each match."
- :group 'apropos
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(const :tag "show scores" verbose)))
@@ -352,7 +341,7 @@ before finding a label."
(defun apropos-words-to-regexp (words wild)
- "Make regexp matching any two of the words in WORDS.
+ "Return a regexp matching any two of the words in WORDS.
WILD should be a subexpression matching wildcards between matches."
(setq words (delete-dups (copy-sequence words)))
(if (null (cdr words))
@@ -644,7 +633,7 @@ search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
consider all symbols (if they match PATTERN).
-Returns list of symbols and documentation found."
+Return list of symbols and documentation found."
(interactive (list (apropos-read-pattern "symbol")
current-prefix-arg))
(setq apropos--current (list #'apropos pattern do-all))
@@ -921,16 +910,14 @@ Returns list of symbols and documentation found."
(defun apropos-value-internal (predicate symbol function)
- (if (funcall predicate symbol)
- (progn
- (setq symbol (prin1-to-string (funcall function symbol)))
- (if (string-match apropos-regexp symbol)
- (progn
- (if apropos-match-face
- (put-text-property (match-beginning 0) (match-end 0)
- 'face apropos-match-face
- symbol))
- symbol)))))
+ (when (funcall predicate symbol)
+ (setq symbol (prin1-to-string (funcall function symbol)))
+ (when (string-match apropos-regexp symbol)
+ (if apropos-match-face
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face apropos-match-face
+ symbol))
+ symbol)))
(defun apropos-documentation-internal (doc)
(cond
@@ -952,6 +939,10 @@ Returns list of symbols and documentation found."
doc))))
(defun apropos-format-plist (pl sep &optional compare)
+ "Return a string representation of the plist PL.
+Paired elements are separated by the string SEP. Only include
+properties matching the current `apropos-regexp' when COMPARE is
+non-nil."
(setq pl (symbol-plist pl))
(let (p p-out)
(while pl
@@ -960,13 +951,12 @@ Returns list of symbols and documentation found."
(put-text-property 0 (length (symbol-name (car pl)))
'face 'apropos-property p)
(setq p nil))
- (if p
- (progn
- (and compare apropos-match-face
- (put-text-property (match-beginning 0) (match-end 0)
- 'face apropos-match-face
- p))
- (setq p-out (concat p-out (if p-out sep) p))))
+ (when p
+ (and compare apropos-match-face
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face apropos-match-face
+ p))
+ (setq p-out (concat p-out (if p-out sep) p)))
(setq pl (nthcdr 2 pl)))
p-out))
diff --git a/test/lisp/apropos-tests.el b/test/lisp/apropos-tests.el
new file mode 100644
index 0000000..4c5522d
--- /dev/null
+++ b/test/lisp/apropos-tests.el
@@ -0,0 +1,133 @@
+;;; apropos-tests.el --- Tests for apropos.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <address@hidden>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'apropos)
+(require 'ert)
+
+(ert-deftest apropos-tests-words-to-regexp-1 ()
+ (let ((re (apropos-words-to-regexp '("foo" "bar") "baz")))
+ (should (string-match-p re "foobazbar"))
+ (should (string-match-p re "barbazfoo"))
+ (should-not (string-match-p re "foo-bar"))
+ (should-not (string-match-p re "foobazbazbar"))))
+
+(ert-deftest apropos-tests-words-to-regexp-2 ()
+ (let ((re (apropos-words-to-regexp '("foo" "bar" "baz") "-")))
+ (should-not (string-match-p re "foo"))
+ (should-not (string-match-p re "foobar"))
+ (should (string-match-p re "foo-bar"))
+ (should (string-match-p re "foo-baz"))))
+
+(ert-deftest apropos-tests-parse-pattern-1 ()
+ (apropos-parse-pattern '("foo"))
+ (should (string-match-p apropos-regexp "foo"))
+ (should (string-match-p apropos-regexp "foo-bar"))
+ (should (string-match-p apropos-regexp "bar-foo"))
+ (should (string-match-p apropos-regexp "foo-foo"))
+ (should-not (string-match-p apropos-regexp "bar")))
+
+(ert-deftest apropos-tests-parse-pattern-2 ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (string-match-p apropos-regexp "foo-bar"))
+ (should (string-match-p apropos-regexp "bar-foo"))
+ (should-not (string-match-p apropos-regexp "foo"))
+ (should-not (string-match-p apropos-regexp "bar"))
+ (should-not (string-match-p apropos-regexp "baz"))
+ (should-not (string-match-p apropos-regexp "foo-foo"))
+ (should-not (string-match-p apropos-regexp "bar-bar")))
+
+(ert-deftest apropos-tests-parse-pattern-3 ()
+ (apropos-parse-pattern '("foo" "bar" "baz"))
+ (should (string-match-p apropos-regexp "foo-bar"))
+ (should (string-match-p apropos-regexp "foo-baz"))
+ (should (string-match-p apropos-regexp "bar-foo"))
+ (should (string-match-p apropos-regexp "bar-baz"))
+ (should (string-match-p apropos-regexp "baz-foo"))
+ (should (string-match-p apropos-regexp "baz-bar"))
+ (should-not (string-match-p apropos-regexp "foo"))
+ (should-not (string-match-p apropos-regexp "bar"))
+ (should-not (string-match-p apropos-regexp "baz"))
+ (should-not (string-match-p apropos-regexp "foo-foo"))
+ (should-not (string-match-p apropos-regexp "bar-bar"))
+ (should-not (string-match-p apropos-regexp "baz-baz")))
+
+(ert-deftest apropos-tests-parse-pattern-single-regexp ()
+ (apropos-parse-pattern "foo+bar")
+ (should-not (string-match-p apropos-regexp "fobar"))
+ (should (string-match-p apropos-regexp "foobar"))
+ (should (string-match-p apropos-regexp "fooobar")))
+
+(ert-deftest apropos-tests-parse-pattern-synonyms ()
+ (let ((apropos-synonyms '(("find" "open" "edit"))))
+ (apropos-parse-pattern '("open"))
+ (should (string-match-p apropos-regexp "find-file"))
+ (should (string-match-p apropos-regexp "open-file"))
+ (should (string-match-p apropos-regexp "edit-file"))))
+
+(ert-deftest apropos-tests-calc-scores ()
+ (let ((str "Return apropos score for string STR."))
+ (should (equal (apropos-calc-scores str '("apr")) '(7)))
+ (should (equal (apropos-calc-scores str '("apr" "str")) '(25 7)))
+ (should (equal (apropos-calc-scores str '("appr" "str")) '(25)))
+ (should-not (apropos-calc-scores str '("appr" "strr")))))
+
+(ert-deftest apropos-tests-score-str ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (< (apropos-score-str "baz")
+ (apropos-score-str "foo baz")
+ (apropos-score-str "foo bar baz"))))
+
+(ert-deftest apropos-tests-score-doc ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (< (apropos-score-doc "baz")
+ (apropos-score-doc "foo baz")
+ (apropos-score-doc "foo bar baz"))))
+
+(ert-deftest apropos-tests-score-symbol ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (< (apropos-score-symbol 'baz)
+ (apropos-score-symbol 'foo-baz)
+ (apropos-score-symbol 'foo-bar-baz))))
+
+(ert-deftest apropos-tests-true-hit ()
+ (should-not (apropos-true-hit "foo" '("foo" "bar")))
+ (should (apropos-true-hit "foo bar" '("foo" "bar")))
+ (should (apropos-true-hit "foo bar baz" '("foo" "bar"))))
+
+(ert-deftest apropos-tests-format-plist ()
+ (setplist 'foo '(a 1 b (2 3) c nil))
+ (apropos-parse-pattern '("b"))
+ (should (equal (apropos-format-plist 'foo ", ")
+ "a 1, b (2 3), c nil"))
+ (should (equal (apropos-format-plist 'foo ", " t)
+ "b (2 3)"))
+ (apropos-parse-pattern '("d"))
+ (should-not (apropos-format-plist 'foo ", " t)))
+
+(provide 'apropos-tests)
+;;; apropos-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 45d42f8: Use lexical-binding in apropos.el and add tests,
Simen Heggest�yl <=