description is a Lisp expression---a call to @code{define-abbrev-table}
that would define @var{name} as it is currently defined, but without
the system abbrevs. (The mode or package using @var{name} is supposed
-to add these to @var{name} separately.) If the Lisp expression would
-not define any abbrevs (i.e.@: it defines an empty abbrev table), this
-function inserts nothing.
+to add these to @var{name} separately.)
@end defun
@node Defining Abbrevs
Save all abbrev definitions (except system abbrevs), for all abbrev
tables listed in @code{abbrev-table-name-list}, in the file
@var{filename}, in the form of a Lisp program that when loaded will
-define the same abbrevs. If @var{filename} is @code{nil} or omitted,
+define the same abbrevs. Tables that do not have any abbrevs to save
+are omitted. If @var{filename} is @code{nil} or omitted,
@code{abbrev-file-name} is used. This function returns @code{nil}.
@end deffn
for abbrevs that have them.
+++
-** 'insert-abbrev-table-description' skips empty tables.
-'insert-abbrev-table-description' skips inserting empty tables when
-inserting non-readable tables. By extension, this makes
-'write-abbrev-file' skip writing empty tables.
+** 'write-abbrev-file' skips empty tables.
+'write-abbrev-file' now skips inserting a 'define-abbrev-table' form for
+tables which do not have any non-system abbrevs to save.
+++
** The new functions and commands 'text-property-search-forward' and
(lambda (s1 s2)
(string< (symbol-name s1)
(symbol-name s2)))))
- (insert-abbrev-table-description table nil))
+ (if (abbrev--table-symbols table)
+ (insert-abbrev-table-description table nil)))
(when (unencodable-char-position (point-min) (point-max) 'utf-8)
(setq coding-system-for-write
(if (> emacs-major-version 24)
If READABLE is nil, an expression is inserted. The expression is
a call to `define-abbrev-table' that when evaluated will define
the abbrev table NAME exactly as it is currently defined.
-Abbrevs marked as \"system abbrevs\" are ignored. If the
-resulting expression would not define any abbrevs, nothing is
-inserted."
+Abbrevs marked as \"system abbrevs\" are ignored."
+ (let ((table (symbol-value name))
+ (symbols (abbrev--table-symbols name readable)))
+ (setq symbols (sort symbols 'string-lessp))
+ (let ((standard-output (current-buffer)))
+ (if readable
+ (progn
+ (insert "(")
+ (prin1 name)
+ (insert ")\n\n")
+ (mapc 'abbrev--describe symbols)
+ (insert "\n\n"))
+ (insert "(define-abbrev-table '")
+ (prin1 name)
+ (if (null symbols)
+ (insert " '())\n\n")
+ (insert "\n '(\n")
+ (mapc 'abbrev--write symbols)
+ (insert " ))\n\n")))
+ nil)))
+
+(defun abbrev--table-symbols (name &optional system)
+ "Return the user abbrev symbols in the abbrev table named NAME.
+NAME is a symbol whose value is an abbrev table. System abbrevs
+are omitted unless SYSTEM is non-nil."
(let ((table (symbol-value name))
(symbols ()))
(mapatoms (lambda (sym)
- (if (and (symbol-value sym) (or readable (not (abbrev-get sym :system))))
+ (if (and (symbol-value sym) (or system (not (abbrev-get sym :system))))
(push sym symbols)))
table)
- (when symbols
- (setq symbols (sort symbols 'string-lessp))
- (let ((standard-output (current-buffer)))
- (if readable
- (progn
- (insert "(")
- (prin1 name)
- (insert ")\n\n")
- (mapc 'abbrev--describe symbols)
- (insert "\n\n"))
- (insert "(define-abbrev-table '")
- (prin1 name)
- (if (null symbols)
- (insert " '())\n\n")
- (insert "\n '(\n")
- (mapc 'abbrev--write symbols)
- (insert " ))\n\n")))
- nil))))
+ symbols))
(defun define-abbrev-table (tablename definitions
&optional docstring &rest props)
(should (= (length table) obarray-default-size))
(should (eq (abbrev-table-get table 'foo) 'bar))))
+(ert-deftest abbrev--table-symbols-test ()
+ (let ((ert-test-abbrevs (setup-test-abbrev-table)))
+ (define-abbrev ert-test-abbrevs "sys" "system abbrev" nil :system t)
+ (should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs))
+ '("a-e-t")))
+ (should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs t))
+ '("a-e-t" "sys")))))
+
(ert-deftest abbrev-table-get-put-test ()
(let ((table (make-abbrev-table)))
(should-not (abbrev-table-get table 'foo))