From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Re: Abbrev tables in elisp with some extra stuff Date: Tue, 16 Oct 2007 16:26:08 -0400 Message-ID: References: <200706201948.06271.andreas.roehler@online.de> <4nvedib77v.fsf@fencepost.gnu.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: ger.gmane.org 1192566438 8093 80.91.229.12 (16 Oct 2007 20:27:18 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 16 Oct 2007 20:27:18 +0000 (UTC) Cc: rgm@gnu.org, andreas.roehler@online.de, emacs-devel@gnu.org To: rms@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Oct 16 22:27:17 2007 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1Iht0N-0006oK-Qv for ged-emacs-devel@m.gmane.org; Tue, 16 Oct 2007 22:27:09 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Iht0G-0007DK-FS for ged-emacs-devel@m.gmane.org; Tue, 16 Oct 2007 16:27:00 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Iht0D-0007D4-2D for emacs-devel@gnu.org; Tue, 16 Oct 2007 16:26:57 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1Iht09-00079H-Fv for emacs-devel@gnu.org; Tue, 16 Oct 2007 16:26:56 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Iht09-000798-Cm for emacs-devel@gnu.org; Tue, 16 Oct 2007 16:26:53 -0400 Original-Received: from x-132-204-253-210.xtpr.umontreal.ca ([132.204.253.210] helo=ceviche.home) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1Ihsze-000298-Fj; Tue, 16 Oct 2007 16:26:47 -0400 Original-Received: by ceviche.home (Postfix, from userid 20848) id 4C6F0B41C1; Tue, 16 Oct 2007 16:26:08 -0400 (EDT) In-Reply-To: (Stefan Monnier's message of "Fri\, 12 Oct 2007 17\:26\:06 -0400") User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/23.0.50 (gnu/linux) X-detected-kernel: by monty-python.gnu.org: Linux 2.6 (newer, 3) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:81019 Archived-At: >> - :case-preserve non-nil means that abbreviations are lookedup without >> case-folding, and the expansion is not capitalized/upcased. >> It seems like a mistake to make this a per-table decision. >> In every abbrev table, abbrevs should preserve case by default. >> To define an abbrev that is only detected in a particular case >> is an exception, so each abbrev needs to be marked if it is >> to work that way. > In my experience, this exception usually holds for groups of abbreviations > or even for all abbrevs defined in a mode (typically for skeleton-abbrevs), > so it seems convenient to set it once and for all for the whole group. > Since we can have many abbrev-tables active at the same time, this is not > a limitation. BTW, the code actually handles :case-preserve both on individual abbrevs and on abbrev-tables. >> - :syntax-table holds the syntax table to use to find the relevant word. >> Why do we want this? > So that we can define abbrevs which include "-" (for example) without > changing the syntax of "-" in the normal syntax-table. Currently python.el > uses an ugly pre-abbrev-expand-hook to cobble up some way to simulate > this feature. mailabbrev.el also needs this. I think I've changed my mind on this: instead of :syntax-table, I want to use :regexp where I can specify that my abbrevs can match anything else than a word. This works as well for python.el and mailabbrev.el and is more general. >> - :abbrev-before-point-function holds a function to use to find the >> abbrev at point. >> Why do we want this? > Mostly to provide other rules than "abbrev name = preceding word". > E.g. there's a sample function in the code I sent to place on this hook > which instead of looking at the preceding word just cycles through all the > abbrevs in the table and checks if it matches text before point, so as to > completely eliminate the "abbrev=word" limitation. Multi-word abbrevs are > regularly requested on gnu.emacs.help (usually not very loudly, admittedly). Now that we have :regexp, I'm not sure it's worth the trouble. >> - :enable-function can be set to a function of no argument which returns >> non-nil iff the abbrevs in this table should be used for this instance >> of `expand-abbrev'. Useful to disable skeleton-abbrevs in strings and >> comments. >> That feature is useful, but shouldn't it be per-abbrev, not per-table? > Same as :case-preserve, it tends to apply to groups of abbrevs. Actually, it's different from :case-preserve because its used earlier (before we've3 have found the abbrev): it's important that it be global to an abbrev-table because it determines whether or not to look for a word (i.e. it determines whether or not to search :regexp or to call :abbrev-before-point-function). Being called early also makes it possible to use it to refresh :regexp (in case you want to let :regexp adapt dynamically). I can easily add support for :enable-function to individual abbrevs if it is considered important, but several uses I can think of need it before we've found the abbrev, so abbrev-tables need them also. >> The right way to do this is to have minor-mode-abbrev-table-alist >> which would work like minor-mode-map-alist. Done. >> +(defmacro abbrev-with-wrapper-hook (var &rest body) >> + "Run BODY wrapped with the VAR hook. >> +VAR is a special hook: its functions are called with one argument which >> +is the \"original\" code, so the hook function can wrap the original function, >> What does "the original function" mean? There is no function >> in the arguments. I think it means the body. I've tried to improve the docstring. >> + `(labels ((loop (--abrev-funs-- --abbrev-global--) >> Redefining `loop' is really confusing. I've renamed it. >> Using `labels' in this way also requires an explanation >> of why it is written this way. I've added comments to try and make things more clear. >> Did you try to write it in a more straightforward way, without >> `labels'? If so, what was the problem with that approach? > lexical scoping *is* the straightforward way. Mostly, I need to create closures (the function arg passed to the hook functions) and the cleanest way to do that is via lexical-let (short of using Miles's lexical scoping branch that is ;-) If CL supported lexically scoped function arguments, the code would be even significantly cleaner. I attached the new version of the code. Stefan --- orig/lisp/abbrev.el +++ mod/lisp/abbrev.el @@ -363,6 +363,534 @@ (if (or noquery (y-or-n-p (format "Expand `%s'? " string))) (expand-abbrev))))))) +;;; Abbrev properties. + + +;; Todo: +;; - abbrev table may be chosen based on context (e.g. mail-abbrev uses an +;; ugly pre-abbrev-expand-hook in order to do abbrev-expansion in the +;; header differently from abbrev expansion in the rest of the message). +;; - multi-word or non-word abbrevs? +;; - abbrevs could have a `predicate' so you can disable them in strings and +;; comments, for example. Maybe the predicate should be on the table +;; rather than on individual abbrevs. This may be enough to cover the +;; above request for context-dependent abbrevs. + +(defun abbrev-table-get (table prop) + "Get the PROP property of abbrev table TABLE." + (let ((sym (intern-soft "" 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))) + (set sym nil) ; Make sure it won't be confused for an abbrev. + (put sym prop val))) + +(defun abbrev-get (sym prop) + (let ((plist (symbol-plist sym))) + (if (listp plist) + (plist-get plist prop) + (if (eq 'count prop) plist)))) + +(defun abbrev-put (sym prop val) + (let ((plist (symbol-plist sym))) + (if (consp plist) + (put sym prop val) + (setplist sym (if (eq 'count prop) val + (list 'count plist prop val)))))) + +(defmacro abbrev-with-wrapper-hook (var &rest body) + "Run BODY wrapped with the VAR hook. +VAR is a special hook: its functions are called with one argument which +is the \"original\" code (the BODY), so the hook function can wrap the +original function, can call it several times, or even not call it at all. +VAR is normally a symbol (a variable) in which case it is treated like a hook, +with a buffer-local and a global part. But it can also be an arbitrary expression. +This is similar to an `around' advice." + (declare (indent 1) (debug t)) + ;; We need those two gensyms because CL's lexical scoping is not available + ;; for function arguments :-( + (let ((funs (make-symbol "funs")) + (global (make-symbol "global"))) + ;; The loop has to be done via recursion rather than a `while'. + `(labels ((runrestofhook (,funs ,global) + ;; `funs' holds the functions left on the hook and `global' + ;; holds the functions left on the global part of the hook + ;; (in case the hook is local). + (lexical-let ((funs ,funs) + (global ,global)) + (if (consp funs) + (if (eq t (car funs)) + (runrestofhook (append global (cdr funs)) nil) + (funcall (car funs) + (lambda () (runrestofhook (cdr funs) global)))) + ;; Once there are no more functions on the hook, run + ;; the original body. + ,@body)))) + (runrestofhook ,var + ;; The global part of the hook, if any. + ,(if (symbolp var) + `(if (local-variable-p ',var) + (default-value ',var))))))) + + +;;; Code that used to be implemented in src/abbrev.c + +(defvar abbrev-table-name-list '(fundamental-mode-abbrev-table + global-abbrev-table) + "List of symbols whose values are abbrev tables.") + +(defun make-abbrev-table (&optional props) + "Create a new, empty abbrev table object." + ;; The value 59 is an arbitrary prime number. + (let ((table (make-vector 59 0))) + ;; 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 + ;; `modiff' can let us detect that an abbrev was added and hence :regexp + ;; needs to be refreshed. + ;; The presence of `modiff' entry is also used as a tag indicating this + ;; vector is really an abbrev-table. + (abbrev-table-put table :abbrev-table-modiff 0) + (while (consp props) + (abbrev-table-put table (pop props) (pop props))) + table)) + +(defun abbrev-table-p (object) + (and (vectorp object) + (numberp (abbrev-table-get object :abbrev-table-modiff)))) + +(defvar global-abbrev-table (make-abbrev-table) + "The abbrev table whose abbrevs affect all buffers. +Each buffer may also have a local abbrev table. +If it does, the local table overrides the global one +for any particular abbrev defined in both.") + +(defvar abbrev-minor-mode-table-alist nil + "Alist of abbrev tables to use for minor modes. +Each element looks like (VARIABLE . ABBREV-TABLE); +ABBREV-TABLE is active whenever VARIABLE's value is non-nil.") + +(defvar fundamental-mode-abbrev-table + (let ((table (make-abbrev-table))) + ;; Set local-abbrev-table's default to be fundamental-mode-abbrev-table. + (setq-default local-abbrev-table table) + table) + "The abbrev table of mode-specific abbrevs for Fundamental Mode.") + +(defvar abbrevs-changed nil + "Set non-nil by defining or altering any word abbrevs. +This causes `save-some-buffers' to offer to save the abbrevs.") + +(defcustom abbrev-all-caps nil + "Non-nil means expand multi-word abbrevs all caps if abbrev was so." + :type 'boolean + :group 'abbrev-mode) + +(defvar abbrev-start-location nil + "Buffer position for `expand-abbrev' to use as the start of the abbrev. +When nil, use the word before point as the abbrev. +Calling `expand-abbrev' sets this to nil.") + +(defvar abbrev-start-location-buffer nil + "Buffer that `abbrev-start-location' has been set for. +Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.") + +(defvar last-abbrev nil + "The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'.") + +(defvar last-abbrev-text nil + "The exact text of the last abbrev expanded. +nil if the abbrev has already been unexpanded.") + +(defvar last-abbrev-location 0 + "The location of the start of the last abbrev expanded.") + +;; (defvar local-abbrev-table fundamental-mode-abbrev-table +;; "Local (mode-specific) abbrev table of current buffer.") +;; (make-variable-buffer-local 'local-abbrev-table) + +(defcustom pre-abbrev-expand-hook nil + "Function or functions to be called before abbrev expansion is done. +This is the first thing that `expand-abbrev' does, and so this may change +the current abbrev table before abbrev lookup happens." + :type 'hook + :group 'abbrev-mode) + +(defun clear-abbrev-table (table) + "Undefine all abbrevs in abbrev table TABLE, leaving it empty." + (setq abbrevs-changed t) + (dotimes (i (length table)) + (aset table i 0))) + +(defun define-abbrev (table name expansion &optional hook count system-flag + ;; In case the abbrev list passed to + ;; `define-abbrev-table' includes extra elements + ;; that we should ignore. + &rest ignore) + "Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK. +NAME must be a string, and should be lower-case. +EXPANSION should usually be a string. +To undefine an abbrev, define it with EXPANSION = nil. +If HOOK is non-nil, it should be a function of no arguments; +it is called after EXPANSION is inserted. +If EXPANSION is not a string, the abbrev is a special one, + which does not expand in the usual way but only runs HOOK. + +COUNT, if specified, gives the initial value for the abbrev's +usage-count, which is incremented each time the abbrev is used. +\(The default is zero.) + +SYSTEM-FLAG, if non-nil, says that this is a \"system\" abbreviation +which should not be saved in the user's abbreviation file. +Unless SYSTEM-FLAG is `force', a system abbreviation will not +overwrite a non-system abbreviation of the same name." + (unless count (setq count 0)) + (let ((sym (intern name table))) + ;; 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))) + (boundp sym) (symbol-value sym) + (not (abbrev-get sym 'system-flag))) + (unless (or system-flag + (and (boundp sym) (fboundp sym) + ;; load-file-name + (equal (symbol-value sym) expansion) + (equal (symbol-function sym) hook))) + (setq abbrevs-changed t)) + (set sym expansion) + (fset sym hook) + (setplist sym (if (null system-flag) count + (list 'count count 'system-flag system-flag))) + (abbrev-table-put table :abbrev-table-modiff + (1+ (abbrev-table-get table :abbrev-table-modiff)))) + name)) + +(defun abbrev--check-chars (abbrev global) + "Check if the characters in ABBREV have word syntax in either the +current (if global is nil) or standard syntax table." + (with-syntax-table + (cond ((null global) (standard-syntax-table)) + ;; ((syntax-table-p global) global) + (t (syntax-table))) + (when (string-match "\\W" abbrev) + (let ((badchars ()) + (pos 0)) + (while (string-match "\\W" abbrev pos) + (pushnew (aref abbrev (match-beginning 0)) badchars) + (setq pos (1+ pos))) + (error "Some abbrev characters (%s) are not word constituents %s" + (apply 'string (nreverse badchars)) + (if global "in the standard syntax" "in this mode")))))) + +(defun define-global-abbrev (abbrev expansion) + "Define ABBREV as a global abbreviation for EXPANSION. +The characters in ABBREV must all be word constituents in the standard +syntax table." + (interactive "sDefine global abbrev: \nsExpansion for %s: ") + (abbrev--check-chars abbrev 'global) + (define-abbrev global-abbrev-table (downcase abbrev) expansion)) + +(defun define-mode-abbrev (abbrev expansion) + "Define ABBREV as a mode-specific abbreviation for EXPANSION. +The characters in ABBREV must all be word-constituents in the current mode." + (interactive "sDefine mode abbrev: \nsExpansion for %s: ") + (unless local-abbrev-table + (error "Major mode has no abbrev table")) + (abbrev--check-chars abbrev nil) + (define-abbrev local-abbrev-table (downcase abbrev) expansion)) + +(defun abbrev-set-member (elem set) + (cond + ((functionp set) (funcall set elem)) + ((eq (car-safe set) 'not) (not (abbrev-set-member elem (cadr set)))) + (t (member elem set)))) + +(defun abbrev--active-tables (&optional tables) + (cond + ((consp tables) tables) + ((vectorp tables) (list tables)) + (t + (let ((tables (if (listp local-abbrev-table) + (append local-abbrev-table + (list global-abbrev-table)) + (list local-abbrev-table global-abbrev-table)))) + ;; Add the minor-mode abbrev tables. + (dolist (x abbrev-minor-mode-table-alist) + (when (and (symbolp (car x)) (boundp (car x)) (symbol-value (car x))) + (setq tables + (if (listp (cdr x)) + (append (cdr x) tables) (cons (cdr x) tables))))) + tables)))) + + +(defun abbrev-symbol (abbrev &optional table) + "Return the symbol representing abbrev named ABBREV. +This symbol's name is ABBREV, but it is not the canonical symbol of that name; +it is interned in an abbrev-table rather than the normal obarray. +The value is nil if that abbrev is not defined. +Optional second arg TABLE is abbrev table to look it up in. +The default is to try buffer's mode-specific abbrev table, then global table." + (let ((tables (abbrev--active-tables table)) + sym) + (while (and tables (not (symbol-value sym))) + (let ((table (pop tables)) + (case-fold (not (abbrev-table-get table :case-preserve)))) + (setq tables (append (abbrev-table-get table :parents) tables)) + (setq sym (intern-soft (if case-fold (downcase abbrev) abbrev) table)) + (if (and (not case-fold) (symbol-value sym)) + ;; The :case-preserve property normally belongs to the + ;; abbrev-table, but the use of this abbrev needs to know if + ;; this abbrev came from a case preserving table or not, so we + ;; save a copy in the abbrev itself. + (abbrev-put sym :case-preserve t)))) + (if (symbol-value sym) + sym))) + + +(defun abbrev-expansion (abbrev &optional table) + "Return the string that ABBREV expands into in the current buffer. +Optionally specify an abbrev table as second arg; +then ABBREV is looked up in that table only." + (symbol-value (abbrev-symbol abbrev table))) + +(defun abbrev-before-point-exhaustive-search (table) + "Sample :abbrev-before-point-function." + (save-excursion + (skip-syntax-backward " ") + (let (res) + (mapatoms (lambda (sym) + (when (symbol-value sym) + (let ((name (symbol-name sym))) + (when (search-backward name (- (point) (length name)) t) + (setq res (list name sym + (match-beginning 0) (match-end 0))))))) + table) + res))) + +(defun abbrev--before-point () + "Try and find an abbrev before point. Return it if found, nil otherwise." + (unless (eq abbrev-start-location-buffer (current-buffer)) + (setq abbrev-start-location nil)) + + (let ((tables (abbrev--active-tables)) + (pos (point)) + start end name res) + + (if abbrev-start-location + (progn + (setq start abbrev-start-location) + (setq abbrev-start-location nil) + ;; Remove the hyphen inserted by `abbrev-prefix-mark'. + (if (and (< start (point-max)) + (eq (char-after start) ?-)) + (delete-region start (1+ start))) + (skip-syntax-backward " ") + (setq end (point)) + (setq name (buffer-substring start end)) + (goto-char pos) ; Restore point. + (list name (abbrev-symbol name tables) start end)) + + (while (and tables (not res)) + (let* ((table (pop tables)) + (enable-fun (abbrev-table-get table :enable-function))) + (setq tables (append (abbrev-table-get table :parents) tables)) + (setq res + (abbrev-with-wrapper-hook + (abbrev-table-get table :abbrev-before-point-function) + (and (or (not enable-fun) (funcall enable-fun)) + (looking-back (or (abbrev-table-get table :regexp) + "\\<\\(\\w+\\)\\W*") + (line-beginning-position)) + (setq start (match-beginning 1)) + (setq end (match-end 1)) + (setq name (buffer-substring start end)) + ;; This will also look it up in parent tables. + ;; This is not on purpose, but it seems harmless. + (list name (abbrev-symbol name table) start end)))) + ;; Restore point. + (goto-char pos))) + res))) + +(defvar abbrev-expand-function nil + "Wrapper hook around `expand-abbrev'. +The functions on this special hook are called with one argument: +a function that performs the abbrev expansion.") + +(defun expand-abbrev () + "Expand the abbrev before point, if there is an abbrev there. +Effective when explicitly called even when `abbrev-mode' is nil. +Returns the abbrev symbol, if expansion took place." + (interactive) + (run-hooks 'pre-abbrev-expand-hook) + (abbrev-with-wrapper-hook abbrev-expand-function + (destructuring-bind (&optional name sym wordstart wordend) + (abbrev--before-point) + (when sym + (let ((value sym)) + (unless (or ;; executing-kbd-macro + noninteractive + (window-minibuffer-p (selected-window))) + ;; Add an undo boundary, in case we are doing this for + ;; a self-inserting command which has avoided making one so far. + (undo-boundary)) + ;; Now sym is the abbrev symbol. + (setq last-abbrev-text name) + (setq last-abbrev sym) + (setq last-abbrev-location wordstart) + ;; Increment use count. + (abbrev-put sym 'count (1+ (abbrev-get sym 'count))) + ;; If this abbrev has an expansion, delete the abbrev + ;; and insert the expansion. + (when (stringp (symbol-value sym)) + (goto-char wordend) + (insert (symbol-value sym)) + (delete-region wordstart wordend) + (let ((case-fold-search nil)) + (when (and (not (abbrev-get sym :case-preserve)) + (string-match "[[:upper:]]" name)) + (if (not (string-match "[[:lower:]]" name)) + ;; Abbrev was all caps. If expansion is multiple words, + ;; normally capitalize each word. + (if (and (not abbrev-all-caps) + (save-excursion + (> (progn (backward-word 1) (point)) + (progn (goto-char wordstart) + (forward-word 1) (point))))) + (upcase-initials-region wordstart (point)) + (upcase-region wordstart (point))) + ;; Abbrev included some caps. Cap first initial of expansion. + (let ((end (point))) + ;; Find the initial. + (goto-char wordstart) + (skip-syntax-forward "^w" (1- end)) + ;; Change just that. + (upcase-initials-region (point) (1+ (point)))))))) + (when (symbol-function sym) + (let* ((hook (symbol-function sym)) + (expanded + ;; If the abbrev has a hook function, run it. + (funcall hook))) + ;; In addition, if the hook function is a symbol with + ;; a non-nil `no-self-insert' property, let the value it + ;; returned specify whether we consider that an expansion took + ;; place. If it returns nil, no expansion has been done. + (if (and (symbolp hook) + (null expanded) + (get hook 'no-self-insert)) + (setq value nil)))) + value))))) + +(defun unexpand-abbrev () + "Undo the expansion of the last abbrev that expanded. +This differs from ordinary undo in that other editing done since then +is not undone." + (interactive) + (save-excursion + (unless (or (< last-abbrev-location (point-min)) + (> last-abbrev-location (point-max))) + (goto-char last-abbrev-location) + (when (stringp last-abbrev-text) + ;; This isn't correct if last-abbrev's hook was used + ;; to do the expansion. + (let ((val (symbol-value last-abbrev))) + (unless (stringp val) + (error "value of abbrev-symbol must be a string")) + (delete-region (point) (+ (point) (length val))) + ;; Don't inherit properties here; just copy from old contents. + (insert last-abbrev-text) + (setq last-abbrev-text nil)))))) + +(defun write--abbrev (sym) + (unless (or (null (symbol-value sym)) (abbrev-get sym 'system-flag)) + (insert " (") + (prin1 name) + (insert " ") + (prin1 (symbol-value sym)) + (insert " ") + (prin1 (symbol-function sym)) + (insert " ") + (prin1 (abbrev-get sym 'count)) + (insert ")\n"))) + +(defun describe--abbrev (sym) + (when (symbol-value sym) + (prin1 (symbol-name sym)) + (if (null (abbrev-get sym 'system-flag)) + (indent-to 15 1) + (insert " (sys)") + (indent-to 20 1)) + (prin1 (abbrev-get sym 'count)) + (indent-to 20 1) + (prin1 (symbol-value sym)) + (when (symbol-function sym) + (indent-to 45 1) + (prin1 (symbol-function sym))) + (terpri))) + +(defun insert-abbrev-table-description (name &optional readable) + "Insert before point a full description of abbrev table named NAME. +NAME is a symbol whose value is an abbrev table. +If optional 2nd arg READABLE is non-nil, a human-readable description +is inserted. Otherwise the description is an expression, +a call to `define-abbrev-table', which would +define the abbrev table NAME exactly as it is currently defined. + +Abbrevs marked as \"system abbrevs\" are omitted." + (let ((table (symbol-value name)) + (symbols ())) + (mapatoms (lambda (sym) (if (symbol-value sym) (push sym symbols))) table) + (setq symbols (sort symbols 'string-lessp)) + (let ((standard-output (current-buffer))) + (if readable + (progn + (insert "(") + (prin1 name) + (insert ")\n\n") + (mapc 'describe--abbrev symbols) + (insert "\n\n")) + (insert "(define-abbrev-table '") + (prin1 name) + (insert " '(") + (mapc 'write--abbrev symbols) + (insert " ))\n\n")) + nil))) + +(defun define-abbrev-table (tablename definitions + &optional docstring &rest props) + "Define TABLENAME (a symbol) as an abbrev table name. +Define abbrevs in it according to DEFINITIONS, which is a list of elements +of the form (ABBREVNAME EXPANSION HOOK USECOUNT SYSTEMFLAG). +\(If the list is shorter than that, omitted elements default to nil). +PROPS is a property list to apply to the table. +Properties with special meaning: +- :parents contains a list of abbrev tables from which this table inherits + abbreviations. +- :case-preserve non-nil means that abbreviations are lookedup without + case-folding, and the expansion is not capitalized/upcased. +- :regexp describes the form of abbrevs. It defaults to \\<\\(\\w+\\)\\W* which + means that an abbrev can only be a single word. The submatch 1 is treated + as the potential name of an abbrev. +- :abbrev-before-point-function holds a function to use to find the + abbrev at point. It should take one argument (a function of no argument + which finds the abbrev using the default method) and return a list of the + form (NAME SYM START END) where NAME is the abbrev name as found in the + buffer, SYM is the abbrev, START and END are the buffer positions where + NAME was found (i.e. NAME = (buffer-substring START END)). +- :enable-function can be set to a function of no argument which returns + non-nil iff the abbrevs in this table should be used for this instance + of `expand-abbrev'." + (let ((table (if (boundp tablename) (symbol-value tablename)))) + (unless table + (setq table (make-abbrev-table props)) + (set tablename table) + (push tablename abbrev-table-name-list)) + (when (stringp docstring) + (put tablename 'variable-documentation docstring)) + (dolist (elt definitions) + (apply 'define-abbrev table elt)))) + (provide 'abbrev) ;; arch-tag: dbd6f3ae-dfe3-40ba-b00f-f9e3ff960df5