9:56 p.m.
Hi All, I would like to commit a patch close to this pending
successful testing by me and hopefully others too.
I don't understand what GNU Emacs system abbrevs are.
A bit of them leaked in by my port from GNU Emacs.
Let me know if you see any issues with that.
GNU Emacs seems to make no effort to present abbrev tables in sorted
order internally. I have taken a different approach for consistency
between file and buffer order and the sorting inside
define-abbrev-table does not show up at all in a
M-x profile-command RET read-abbrev-file RET
for me.
I have waited long for the sorted abbrev feature to ease review of
changes to my abbrev file by use of M-x erevision.
Looks like my patience payed off finally ;->
Best regards!
Adrian
xemacs-21.5-clean ChangeLog patch:
Diff command: cvs -q diff -U 0
Files affected: lisp/ChangeLog src/ChangeLog
Index: lisp/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.795
diff -u -U0 -r1.795 ChangeLog
--- lisp/ChangeLog 12 May 2007 13:12:26 -0000 1.795
+++ lisp/ChangeLog 13 May 2007 20:45:04 -0000
＠＠ -0,0 +1,11 ＠＠
+2007-05-13 Adrian Aichner <adrian(a)xemacs.org>
+
+ * abbrev.el: Sort abbrev-table-name-list entries by name. Unlike
+ GNU Emacs we keep tables sorted internally too, not only when
+ writing them by `write-abbrev-file'.
+ * abbrev.el (define-abbrev-table): Sort abbrev-table-name-list by
+ table names, so that `insert-abbrevs', `list-abbrevs', and
+ `write-abbrev-file' all present them in the same order.
+ * abbrev.el (insert-abbrev-table-description): Removed. Losely
+ synced to abbrev.c from GNU Emacs.
+
Index: src/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.1059
diff -u -U0 -r1.1059 ChangeLog
--- src/ChangeLog 12 May 2007 10:59:15 -0000 1.1059
+++ src/ChangeLog 13 May 2007 20:45:15 -0000
＠＠ -0,0 +1,7 ＠＠
+2007-05-13 Adrian Aichner <adrian(a)xemacs.org>
+
+ * abbrev.c: Sort abbreviations by name, similar to GNU Emacs.
+ * abbrev.c (write_abbrev): Losely ported from GNU Emacs.
+ * abbrev.c (describe_abbrev): Ditto.
+ * abbrev.c (Finsert_abbrev_table_description): Ditto.
+
xemacs-21.5-clean source patch:
Diff command: cvs -f -z3 -q diff -u -w -N
Files affected: lisp/abbrev.el
===================================================================
RCS src/abbrev.c
===================================================================
RCS
Index: src/abbrev.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/abbrev.c,v
retrieving revision 1.20
diff -u -w -r1.20 abbrev.c
--- src/abbrev.c 4 Nov 2004 23:06:15 -0000 1.20
+++ src/abbrev.c 13 May 2007 20:25:11 -0000
＠＠ -75,6 +75,7 ＠＠
/* Hook to run before expanding any abbrev. */
Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
+Lisp_Object Qsystem_type, Qcount;
struct abbrev_match_mapper_closure
{
＠＠ -402,12 +403,169 ＠＠
return Vlast_abbrev;
}
+static void
+write_abbrev (Lisp_Object sym, Lisp_Object stream)
+{
+ Lisp_Object name, count, system_flag;
+ /* This function can GC */
+ struct buffer *buf = current_buffer;
+
+ if (INTP (XSYMBOL (sym)->plist))
+ {
+ count = XSYMBOL (sym)->plist;
+ system_flag = Qnil;
+ }
+ else
+ {
+ count = Fget (sym, Qcount, Qunbound);
+ system_flag = Fget (sym, Qsystem_type, Qunbound);
+ }
+
+ if (NILP (XSYMBOL_VALUE (sym)) || ! NILP (system_flag))
+ return;
+
+ buffer_insert_c_string (buf, " (");
+ name = Fsymbol_name (sym);
+ Fprin1 (name, stream);
+ buffer_insert_c_string (buf, " ");
+ Fprin1 (XSYMBOL_VALUE (sym), stream);
+ buffer_insert_c_string (buf, " ");
+ Fprin1 (XSYMBOL (sym)->function, stream);
+ buffer_insert_c_string (buf, " ");
+ Fprin1 (count, stream);
+ buffer_insert_c_string (buf, ")\n");
+}
+
+static void
+describe_abbrev (Lisp_Object sym, Lisp_Object stream)
+{
+ Lisp_Object one, count, system_flag;
+ /* This function can GC */
+ struct buffer *buf = current_buffer;
+
+ if (INTP (XSYMBOL (sym)->plist))
+ {
+ count = XSYMBOL (sym)->plist;
+ system_flag = Qnil;
+ }
+ else
+ {
+ count = Fget (sym, Qcount, Qunbound);
+ system_flag = Fget (sym, Qsystem_type, Qunbound);
+ }
+
+ if (NILP (XSYMBOL_VALUE (sym)))
+ return;
+
+ one = make_int (1);
+ Fprin1 (Fsymbol_name (sym), stream);
+
+ if (!NILP (system_flag))
+ {
+ buffer_insert_c_string (buf, " (sys)");
+ Findent_to (make_int (20), one, Qnil);
+ }
+ else
+ Findent_to (make_int (15), one, Qnil);
+
+ Fprin1 (count, stream);
+ Findent_to (make_int (20), one, Qnil);
+ Fprin1 (XSYMBOL_VALUE (sym), stream);
+ if (!NILP (XSYMBOL (sym)->function))
+ {
+ Findent_to (make_int (45), one, Qnil);
+ Fprin1 (XSYMBOL (sym)->function, stream);
+ }
+ buffer_insert_c_string (buf, "\n");
+}
+
+static int
+record_symbol (Lisp_Object sym, void *arg)
+{
+ Lisp_Object closure = * (Lisp_Object *) arg;
+ XSETCDR (closure, Fcons (sym, XCDR (closure)));
+ return 0; /* Never stop */
+}
+
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,
+ 1, 2, 0, /*
+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 normally omitted. However, if
+READABLE is non-nil, they are listed. */
+ (name, readable))
+{
+ Lisp_Object table;
+ Lisp_Object symbols;
+ Lisp_Object stream;
+ /* This function can GC */
+ struct buffer *buf = current_buffer;
+
+ CHECK_SYMBOL (name);
+ table = Fsymbol_value (name);
+ CHECK_VECTOR (table);
+
+ /* FIXME: what's the XEmacs equivalent? APA */
+ /* XSETBUFFER (stream, current_buffer); */
+ /* Does not seem to work: */
+ /* Fset_buffer (stream); */
+ stream = wrap_buffer (current_buffer);
+
+ symbols = Fcons (Qnil, Qnil);
+ /* Lisp_Object closure = Fcons (Qnil, Qnil); */
+ /* struct gcpro gcpro1; */
+ /* GCPRO1 (closure); */
+ /* map_obarray (table, record_symbol, symbols); */
+ map_obarray (table, record_symbol, &symbols);
+ /* map_obarray (table, record_symbol, &closure); */
+ symbols = XCDR (symbols);
+ symbols = Fsort (symbols, Qstring_lessp);
+
+ if (!NILP (readable))
+ {
+ buffer_insert_c_string (buf, "(");
+ Fprin1 (name, stream);
+ buffer_insert_c_string (buf, ")\n\n");
+ while (! NILP (symbols))
+ {
+ describe_abbrev (XCAR (symbols), stream);
+ symbols = XCDR (symbols);
+ }
+
+ buffer_insert_c_string (buf, "\n\n");
+ }
+ else
+ {
+ buffer_insert_c_string (buf, "(define-abbrev-table '");
+ Fprin1 (name, stream);
+ buffer_insert_c_string (buf, " '(\n");
+ while (! NILP (symbols))
+ {
+ write_abbrev (XCAR (symbols), stream);
+ symbols = XCDR (symbols);
+ }
+ buffer_insert_c_string (buf, " ))\n\n");
+ }
+
+ return Qnil;
+}
void
syms_of_abbrev (void)
{
+ DEFSYMBOL(Qcount);
+ Qcount = intern ("count");
+ staticpro (&Qcount);
+ DEFSYMBOL(Qsystem_type);
+ Qsystem_type = intern ("system-type");
DEFSYMBOL (Qpre_abbrev_expand_hook);
DEFSUBR (Fexpand_abbrev);
+ DEFSUBR (Finsert_abbrev_table_description);
}
void
Index: lisp/abbrev.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/abbrev.el,v
retrieving revision 1.6
diff -u -w -r1.6 abbrev.el
--- lisp/abbrev.el 14 Apr 2002 12:42:04 -0000 1.6
+++ lisp/abbrev.el 13 May 2007 20:25:11 -0000
＠＠ -87,7 +87,9 ＠＠
((not table)
(setq table (make-abbrev-table))
(set table-name table)
- (setq abbrev-table-name-list (cons table-name abbrev-table-name-list)))
+ (setq abbrev-table-name-list
+ (sort (cons table-name abbrev-table-name-list)
+ #'string-lessp)))
(t
(setq table (wrong-type-argument 'vectorp table))
(set table-name table)))
＠＠ -209,64 +211,64 ＠＠
(goto-char opoint)))))
-
-(defun insert-abbrev-table-description (name &optional human-readable)
- "Insert before point a full description of abbrev table named NAME.
-NAME is a symbol whose value is an abbrev table.
-If optional second argument HUMAN-READABLE is non-nil, insert a
-human-readable description. 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."
- (let ((table (symbol-value name))
- (stream (current-buffer)))
- (message "Abbrev-table %s..." name)
- (if human-readable
- (progn
- (prin1 (list name) stream)
- ;; Need two terpri's or cretinous edit-abbrevs blows out
- (terpri stream)
- (terpri stream)
- (mapatoms (function (lambda (sym)
- (if (symbol-value sym)
- (let* ((n (prin1-to-string (symbol-name sym)))
- (pos (length n)))
- (princ n stream)
- (while (< pos 14)
- (write-char ?\ stream)
- (setq pos (1+ pos)))
- (princ (format " %-5S " (symbol-plist sym))
- stream)
- (if (not (symbol-function sym))
- (prin1 (symbol-value sym) stream)
- (progn
- (setq n (prin1-to-string (symbol-value sym))
- pos (+ pos 6 (length n)))
- (princ n stream)
- (while (< pos 45)
- (write-char ?\ stream)
- (setq pos (1+ pos)))
- (prin1 (symbol-function sym) stream)))
- (terpri stream)))))
- table)
- (terpri stream))
- (progn
- (princ "\(define-abbrev-table '" stream)
- (prin1 name stream)
- (princ " '\(\n" stream)
- (mapatoms (function (lambda (sym)
- (if (symbol-value sym)
- (progn
- (princ " " stream)
- (prin1 (list (symbol-name sym)
- (symbol-value sym)
- (symbol-function sym)
- (symbol-plist sym))
- stream)
- (terpri stream)))))
- table)
- (princ " \)\)\n" stream)))
- (terpri stream))
- (message ""))
+; APA: Moved to c (ported function from GNU Emacs to src/abbrev.c)
+; (defun insert-abbrev-table-description (name &optional human-readable)
+; "Insert before point a full description of abbrev table named NAME.
+; NAME is a symbol whose value is an abbrev table.
+; If optional second argument HUMAN-READABLE is non-nil, insert a
+; human-readable description. 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."
+; (let ((table (symbol-value name))
+; (stream (current-buffer)))
+; (message "Abbrev-table %s..." name)
+; (if human-readable
+; (progn
+; (prin1 (list name) stream)
+; ;; Need two terpri's or cretinous edit-abbrevs blows out
+; (terpri stream)
+; (terpri stream)
+; (mapatoms (function (lambda (sym)
+; (if (symbol-value sym)
+; (let* ((n (prin1-to-string (symbol-name sym)))
+; (pos (length n)))
+; (princ n stream)
+; (while (< pos 14)
+; (write-char ?\ stream)
+; (setq pos (1+ pos)))
+; (princ (format " %-5S " (symbol-plist sym))
+; stream)
+; (if (not (symbol-function sym))
+; (prin1 (symbol-value sym) stream)
+; (progn
+; (setq n (prin1-to-string (symbol-value sym))
+; pos (+ pos 6 (length n)))
+; (princ n stream)
+; (while (< pos 45)
+; (write-char ?\ stream)
+; (setq pos (1+ pos)))
+; (prin1 (symbol-function sym) stream)))
+; (terpri stream)))))
+; table)
+; (terpri stream))
+; (progn
+; (princ "\(define-abbrev-table '" stream)
+; (prin1 name stream)
+; (princ " '\(\n" stream)
+; (mapatoms (function (lambda (sym)
+; (if (symbol-value sym)
+; (progn
+; (princ " " stream)
+; (prin1 (list (symbol-name sym)
+; (symbol-value sym)
+; (symbol-function sym)
+; (symbol-plist sym))
+; stream)
+; (terpri stream)))))
+; table)
+; (princ " \)\)\n" stream)))
+; (terpri stream))
+; (message ""))
;;; End code not in FSF
(defun abbrev-mode (arg)
--
Adrian Aichner
mailto:adrian＠xemacs.org
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches