mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-01 09:51:22 -08:00
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
This commit is contained in:
parent
ebad964b3a
commit
5c81fd58e3
3 changed files with 60 additions and 28 deletions
|
|
@ -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."
|
||||||
"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."
|
||||||
|
|
||||||
(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.
|
||||||
(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."
|
||||||
|
|
||||||
(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,12 +460,12 @@ 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)))
|
||||||
(throw 'some t)))
|
(throw 'some t)))
|
||||||
object))))
|
object))))
|
||||||
|
|
||||||
(defvar global-abbrev-table (make-abbrev-table)
|
(defvar global-abbrev-table (make-abbrev-table)
|
||||||
"The abbrev table whose abbrevs affect all buffers.
|
"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)
|
(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:
|
||||||
(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."
|
||||||
;; 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,17 +1005,17 @@ 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
|
||||||
(lambda () (interactive)
|
(lambda () (interactive)
|
||||||
(abbrev-insert ',abbrev)))
|
(abbrev-insert ',abbrev)))
|
||||||
entries))))
|
entries))))
|
||||||
table)
|
table)
|
||||||
(nconc (make-sparse-keymap prompt)
|
(nconc (make-sparse-keymap prompt)
|
||||||
(sort entries (lambda (x y)
|
(sort entries (lambda (x y)
|
||||||
(funcall sortfun (nth 2 x) (nth 2 y)))))))
|
(funcall sortfun (nth 2 x) (nth 2 y)))))))
|
||||||
|
|
||||||
;; Keep it after define-abbrev-table, since define-derived-mode uses
|
;; Keep it after define-abbrev-table, since define-derived-mode uses
|
||||||
;; define-abbrev-table.
|
;; define-abbrev-table.
|
||||||
|
|
|
||||||
|
|
@ -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")
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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.
|
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||||
|
|
||||||
|
|
@ -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 @@
|
||||||
(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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue