From b78f84205102a710b4c339ee8958e3f04c20adff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Wojnowski?= Date: Sun, 8 Nov 2015 19:19:15 +0100 Subject: [PATCH 2/2] Use obarray functions from obarray-lib. * lisp/abbrev.el (copy-abbrev-table, abbrev-table-p, make-abbrev-table, abbrev-table-get, abbrev-table-put, abbrev-table-empty-p, clear-abbrev-table, define-abbrev, abbrev--symbol, abbrev-table-menu): delegate to obarray-lib functions. * lisp/loadup.el: load obarray-lib before abbrev * test/automated/abbrev-tests.el: new tests --- lisp/abbrev.el | 50 +++++++++++++++++++++--------------------- lisp/loadup.el | 1 + test/automated/abbrev-tests.el | 35 +++++++++++++++++++++++++++-- 3 files changed, 59 insertions(+), 27 deletions(-) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 43a905b..6dfeb10 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -33,6 +33,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'obarray-lib) (defgroup abbrev-mode nil "Word abbreviations mode." @@ -87,7 +88,7 @@ be replaced by its expansion." "Make a new abbrev-table with the same abbrevs as TABLE. Does not copy property lists." (let ((new-table (make-abbrev-table))) - (mapatoms + (obarray-foreach (lambda (symbol) (define-abbrev new-table (symbol-name symbol) @@ -406,12 +407,12 @@ A prefix argument means don't query; expand all abbrevs." (defun abbrev-table-get (table prop) "Get the PROP property of abbrev table TABLE." - (let ((sym (intern-soft "" table))) + (let ((sym (obarray-get table ""))) (if sym (get sym prop)))) (defun abbrev-table-put (table prop val) "Set the PROP property of abbrev table TABLE to VAL." - (let ((sym (intern "" table))) + (let ((sym (obarray-put table ""))) (set sym nil) ; Make sure it won't be confused for an abbrev. (put sym prop val))) @@ -435,8 +436,7 @@ See `define-abbrev' for the effect of some special properties. (defun make-abbrev-table (&optional props) "Create a new, empty abbrev table object. PROPS is a list of properties." - ;; The value 59 is an arbitrary prime number. - (let ((table (make-vector 59 0))) + (let ((table (obarray-make))) ;; Each abbrev-table has a `modiff' counter which can be used to detect ;; when an abbreviation was added. An example of use would be to ;; construct :regexp dynamically as the union of all abbrev names, so @@ -451,7 +451,7 @@ PROPS is a list of properties." (defun abbrev-table-p (object) "Return non-nil if OBJECT is an abbrev table." - (and (vectorp object) + (and (obarray-p object) (numberp (abbrev-table-get object :abbrev-table-modiff)))) (defun abbrev-table-empty-p (object &optional ignore-system) @@ -460,12 +460,12 @@ If IGNORE-SYSTEM is non-nil, system definitions are ignored." (unless (abbrev-table-p object) (error "Non abbrev table object")) (not (catch 'some - (mapatoms (lambda (abbrev) - (unless (or (zerop (length (symbol-name abbrev))) - (and ignore-system - (abbrev-get abbrev :system))) - (throw 'some t))) - object)))) + (obarray-foreach (lambda (abbrev) + (unless (or (zerop (length (symbol-name abbrev))) + (and ignore-system + (abbrev-get abbrev :system))) + (throw 'some t))) + object)))) (defvar global-abbrev-table (make-abbrev-table) "The abbrev table whose abbrevs affect all buffers. @@ -529,12 +529,12 @@ the current abbrev table before abbrev lookup happens." (defun clear-abbrev-table (table) "Undefine all abbrevs in abbrev table TABLE, leaving it empty." (setq abbrevs-changed t) - (let* ((sym (intern-soft "" table))) + (let* ((sym (obarray-get table ""))) (dotimes (i (length table)) (aset table i 0)) ;; Preserve the table's properties. (cl-assert sym) - (let ((newsym (intern "" table))) + (let ((newsym (obarray-put table ""))) (set newsym nil) ; Make sure it won't be confused for an abbrev. (setplist newsym (symbol-plist sym))) (abbrev-table-put table :abbrev-table-modiff @@ -583,7 +583,7 @@ An obsolete but still supported calling form is: (setq props (plist-put props :abbrev-table-modiff (abbrev-table-get table :abbrev-table-modiff))) (let ((system-flag (plist-get props :system)) - (sym (intern name table))) + (sym (obarray-put table name))) ;; Don't override a prior user-defined abbrev with a system abbrev, ;; unless system-flag is `force'. (unless (and (not (memq system-flag '(nil force))) @@ -673,10 +673,10 @@ The value is nil if that abbrev is not defined." ;; abbrevs do, we have to be careful. (sym ;; First try without case-folding. - (or (intern-soft abbrev table) + (or (obarray-get table abbrev) (when case-fold ;; We didn't find any abbrev, try case-folding. - (let ((sym (intern-soft (downcase abbrev) table))) + (let ((sym (obarray-get table (downcase abbrev)))) ;; Only use it if it doesn't require :case-fixed. (and sym (not (abbrev-get sym :case-fixed)) sym)))))) @@ -1005,14 +1005,14 @@ PROMPT is the prompt to use for the keymap. SORTFUN is passed to `sort' to change the default ordering." (unless sortfun (setq sortfun 'string-lessp)) (let ((entries ())) - (mapatoms (lambda (abbrev) - (when (symbol-value abbrev) - (let ((name (symbol-name abbrev))) - (push `(,(intern name) menu-item ,name - (lambda () (interactive) - (abbrev-insert ',abbrev))) - entries)))) - table) + (obarray-foreach (lambda (abbrev) + (when (symbol-value abbrev) + (let ((name (symbol-name abbrev))) + (push `(,(intern name) menu-item ,name + (lambda () (interactive) + (abbrev-insert ',abbrev))) + entries)))) + table) (nconc (make-sparse-keymap prompt) (sort entries (lambda (x y) (funcall sortfun (nth 2 x) (nth 2 y))))))) diff --git a/lisp/loadup.el b/lisp/loadup.el index fef111f..e9d03d9 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -149,6 +149,7 @@ (load "emacs-lisp/nadvice") (load "emacs-lisp/cl-preloaded") (load "minibuffer") ;After loaddefs, for define-minor-mode. +(load "obarray-lib") ;abbrev.el is implemented in terms of obarrays. (load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table. (load "simple") diff --git a/test/automated/abbrev-tests.el b/test/automated/abbrev-tests.el index d08e026..17aea5d 100644 --- a/test/automated/abbrev-tests.el +++ b/test/automated/abbrev-tests.el @@ -1,4 +1,4 @@ -;;; abbrev-tests.el --- Test suite for abbrevs. +;;; abbrev-tests.el --- Test suite for abbrevs -*- lexical-binding: t; -*- ;; Copyright (C) 2015 Free Software Foundation, Inc. @@ -20,11 +20,43 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . +;;; Commentary: + ;;; Code: (require 'ert) (require 'abbrev) +(ert-deftest abbrev-table-p-test () + (should-not (abbrev-table-p 42)) + (should-not (abbrev-table-p "aoeu")) + (should-not (abbrev-table-p '())) + (should-not (abbrev-table-p [])) + ;; Missing :abbrev-table-modiff counter: + (should-not (abbrev-table-p (obarray-make))) + (let* ((table (obarray-make))) + (abbrev-table-put table :abbrev-table-modiff 42) + (should (abbrev-table-p table)))) + +(ert-deftest abbrev-make-abbrev-table-test () + ;; Table without properties: + (let ((table (make-abbrev-table))) + (should (abbrev-table-p table)) + (should (= (length table) obarray-default-size))) + ;; Table with one property 'foo with value 'bar: + (let ((table (make-abbrev-table '(foo bar)))) + (should (abbrev-table-p table)) + (should (= (length table) obarray-default-size)) + (should (eq (abbrev-table-get table 'foo) 'bar)))) + +(ert-deftest abbrev-table-get-put-test () + (let ((table (make-abbrev-table))) + (should-not (abbrev-table-get table 'foo)) + (should (= (abbrev-table-put table 'foo 42) 42)) + (should (= (abbrev-table-get table 'foo) 42)) + (should (eq (abbrev-table-put table 'foo 'bar) 'bar)) + (should (eq (abbrev-table-get table 'foo) 'bar)))) + (ert-deftest copy-abbrev-table-test () (defvar foo-abbrev-table nil) ; Avoid compiler warning (define-abbrev-table 'foo-abbrev-table @@ -39,5 +71,4 @@ (should-not (string-equal (buffer-name) "*Backtrace*"))) (provide 'abbrev-tests) - ;;; abbrev-tests.el ends here -- 2.1.4