Commit 5c81fd58 authored by Przemysław Wojnowski's avatar Przemysław Wojnowski Committed by NicolasPetton
Browse files

Use obarray functions from obarray.

* 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.el functions.
* lisp/loadup.el: load obarray before abbrev
* test/automated/abbrev-tests.el: new tests
parent ebad964b
...@@ -33,6 +33,7 @@ ...@@ -33,6 +33,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'cl-lib))
(require 'obarray)
(defgroup abbrev-mode nil (defgroup abbrev-mode nil
"Word abbreviations mode." "Word abbreviations mode."
...@@ -87,7 +88,7 @@ be replaced by its expansion." ...@@ -87,7 +88,7 @@ be replaced by its expansion."
"Make a new abbrev-table with the same abbrevs as TABLE. "Make a new abbrev-table with the same abbrevs as TABLE.
Does not copy property lists." Does not copy property lists."
(let ((new-table (make-abbrev-table))) (let ((new-table (make-abbrev-table)))
(mapatoms (obarray-map
(lambda (symbol) (lambda (symbol)
(define-abbrev new-table (define-abbrev new-table
(symbol-name symbol) (symbol-name symbol)
...@@ -406,12 +407,12 @@ A prefix argument means don't query; expand all abbrevs." ...@@ -406,12 +407,12 @@ A prefix argument means don't query; expand all abbrevs."
(defun abbrev-table-get (table prop) (defun abbrev-table-get (table prop)
"Get the PROP property of abbrev table TABLE." "Get the PROP property of abbrev table TABLE."
(let ((sym (intern-soft "" table))) (let ((sym (obarray-get table "")))
(if sym (get sym prop)))) (if sym (get sym prop))))
(defun abbrev-table-put (table prop val) (defun abbrev-table-put (table prop val)
"Set the PROP property of abbrev table TABLE to 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. (set sym nil) ; Make sure it won't be confused for an abbrev.
(put sym prop val))) (put sym prop val)))
...@@ -435,8 +436,7 @@ See `define-abbrev' for the effect of some special properties. ...@@ -435,8 +436,7 @@ See `define-abbrev' for the effect of some special properties.
(defun make-abbrev-table (&optional props) (defun make-abbrev-table (&optional props)
"Create a new, empty abbrev table object. "Create a new, empty abbrev table object.
PROPS is a list of properties." PROPS is a list of properties."
;; The value 59 is an arbitrary prime number. (let ((table (obarray-make)))
(let ((table (make-vector 59 0)))
;; Each abbrev-table has a `modiff' counter which can be used to detect ;; 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 ;; when an abbreviation was added. An example of use would be to
;; construct :regexp dynamically as the union of all abbrev names, so ;; construct :regexp dynamically as the union of all abbrev names, so
...@@ -451,7 +451,7 @@ PROPS is a list of properties." ...@@ -451,7 +451,7 @@ PROPS is a list of properties."
(defun abbrev-table-p (object) (defun abbrev-table-p (object)
"Return non-nil if OBJECT is an abbrev table." "Return non-nil if OBJECT is an abbrev table."
(and (vectorp object) (and (obarrayp object)
(numberp (abbrev-table-get object :abbrev-table-modiff)))) (numberp (abbrev-table-get object :abbrev-table-modiff))))
(defun abbrev-table-empty-p (object &optional ignore-system) (defun abbrev-table-empty-p (object &optional ignore-system)
...@@ -460,7 +460,7 @@ If IGNORE-SYSTEM is non-nil, system definitions are ignored." ...@@ -460,7 +460,7 @@ If IGNORE-SYSTEM is non-nil, system definitions are ignored."
(unless (abbrev-table-p object) (unless (abbrev-table-p object)
(error "Non abbrev table object")) (error "Non abbrev table object"))
(not (catch 'some (not (catch 'some
(mapatoms (lambda (abbrev) (obarray-map (lambda (abbrev)
(unless (or (zerop (length (symbol-name abbrev))) (unless (or (zerop (length (symbol-name abbrev)))
(and ignore-system (and ignore-system
(abbrev-get abbrev :system))) (abbrev-get abbrev :system)))
...@@ -529,12 +529,12 @@ the current abbrev table before abbrev lookup happens." ...@@ -529,12 +529,12 @@ the current abbrev table before abbrev lookup happens."
(defun clear-abbrev-table (table) (defun clear-abbrev-table (table)
"Undefine all abbrevs in abbrev table TABLE, leaving it empty." "Undefine all abbrevs in abbrev table TABLE, leaving it empty."
(setq abbrevs-changed t) (setq abbrevs-changed t)
(let* ((sym (intern-soft "" table))) (let* ((sym (obarray-get table "")))
(dotimes (i (length table)) (dotimes (i (length table))
(aset table i 0)) (aset table i 0))
;; Preserve the table's properties. ;; Preserve the table's properties.
(cl-assert sym) (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. (set newsym nil) ; Make sure it won't be confused for an abbrev.
(setplist newsym (symbol-plist sym))) (setplist newsym (symbol-plist sym)))
(abbrev-table-put table :abbrev-table-modiff (abbrev-table-put table :abbrev-table-modiff
...@@ -583,7 +583,7 @@ An obsolete but still supported calling form is: ...@@ -583,7 +583,7 @@ An obsolete but still supported calling form is:
(setq props (plist-put props :abbrev-table-modiff (setq props (plist-put props :abbrev-table-modiff
(abbrev-table-get table :abbrev-table-modiff))) (abbrev-table-get table :abbrev-table-modiff)))
(let ((system-flag (plist-get props :system)) (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, ;; Don't override a prior user-defined abbrev with a system abbrev,
;; unless system-flag is `force'. ;; unless system-flag is `force'.
(unless (and (not (memq system-flag '(nil force))) (unless (and (not (memq system-flag '(nil force)))
...@@ -673,10 +673,10 @@ The value is nil if that abbrev is not defined." ...@@ -673,10 +673,10 @@ The value is nil if that abbrev is not defined."
;; abbrevs do, we have to be careful. ;; abbrevs do, we have to be careful.
(sym (sym
;; First try without case-folding. ;; First try without case-folding.
(or (intern-soft abbrev table) (or (obarray-get table abbrev)
(when case-fold (when case-fold
;; We didn't find any abbrev, try case-folding. ;; 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. ;; Only use it if it doesn't require :case-fixed.
(and sym (not (abbrev-get sym :case-fixed)) (and sym (not (abbrev-get sym :case-fixed))
sym)))))) sym))))))
...@@ -1005,7 +1005,7 @@ PROMPT is the prompt to use for the keymap. ...@@ -1005,7 +1005,7 @@ PROMPT is the prompt to use for the keymap.
SORTFUN is passed to `sort' to change the default ordering." SORTFUN is passed to `sort' to change the default ordering."
(unless sortfun (setq sortfun 'string-lessp)) (unless sortfun (setq sortfun 'string-lessp))
(let ((entries ())) (let ((entries ()))
(mapatoms (lambda (abbrev) (obarray-map (lambda (abbrev)
(when (symbol-value abbrev) (when (symbol-value abbrev)
(let ((name (symbol-name abbrev))) (let ((name (symbol-name abbrev)))
(push `(,(intern name) menu-item ,name (push `(,(intern name) menu-item ,name
......
...@@ -153,6 +153,7 @@ ...@@ -153,6 +153,7 @@
(load "emacs-lisp/nadvice") (load "emacs-lisp/nadvice")
(load "emacs-lisp/cl-preloaded") (load "emacs-lisp/cl-preloaded")
(load "minibuffer") ;After loaddefs, for define-minor-mode. (load "minibuffer") ;After loaddefs, for define-minor-mode.
(load "obarray") ;abbrev.el is implemented in terms of obarrays.
(load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table. (load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table.
(load "simple") (load "simple")
......
;;; abbrev-tests.el --- Test suite for abbrevs. ;;; abbrev-tests.el --- Test suite for abbrevs -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Free Software Foundation, Inc. ;; Copyright (C) 2015 Free Software Foundation, Inc.
...@@ -20,11 +20,43 @@ ...@@ -20,11 +20,43 @@
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code: ;;; Code:
(require 'ert) (require 'ert)
(require 'abbrev) (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 () (ert-deftest copy-abbrev-table-test ()
(defvar foo-abbrev-table nil) ; Avoid compiler warning (defvar foo-abbrev-table nil) ; Avoid compiler warning
(define-abbrev-table 'foo-abbrev-table (define-abbrev-table 'foo-abbrev-table
...@@ -39,5 +71,4 @@ ...@@ -39,5 +71,4 @@
(should-not (string-equal (buffer-name) "*Backtrace*"))) (should-not (string-equal (buffer-name) "*Backtrace*")))
(provide 'abbrev-tests) (provide 'abbrev-tests)
;;; abbrev-tests.el ends here ;;; abbrev-tests.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment