Mercurial > hg > xemacs-beta

changeset 3965:69c43a181729

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2007-05-19 18:41:56 by adrian]
author adrian
date Sat, 19 May 2007 18:42:17 +0000
parents a4917b3c97cc
children 612182e9384f
files lisp/ChangeLog lisp/abbrev.el src/ChangeLog src/abbrev.c
diffstat 4 files changed, 258 insertions(+), 60 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat May 19 18:04:19 2007 +0000
+++ b/lisp/ChangeLog	Sat May 19 18:42:17 2007 +0000
@@ -1,3 +1,14 @@
+2007-05-13  Adrian Aichner  <adrian@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.
+
 2007-04-30  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* code-files.el (set-buffer-file-coding-system):
@@ -20,7 +31,7 @@
 	* dumped-lisp.el (preloaded-file-list): Move resize-minibuffer
 	before simple.
 
-	* resize-minibuffer.el: Remove CVS $Id: ChangeLog,v 1.795 2007/05/12 13:12:26 aidan Exp $ cookie..
+	* resize-minibuffer.el: Remove CVS $Id: ChangeLog,v 1.796 2007/05/19 18:41:56 adrian Exp $ cookie..
 
 	* resize-minibuffer.el (resize-minibuffer-mode): Remove autoload.
 
--- a/lisp/abbrev.el	Sat May 19 18:04:19 2007 +0000
+++ b/lisp/abbrev.el	Sat May 19 18:42:17 2007 +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)
--- a/src/ChangeLog	Sat May 19 18:04:19 2007 +0000
+++ b/src/ChangeLog	Sat May 19 18:42:17 2007 +0000
@@ -1,3 +1,10 @@
+2007-05-13  Adrian Aichner  <adrian@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.
+	
 2007-05-03  Vin Shelton  <acs@xemacs.org>
 
 	* dumper.c (pdump): Don't close an already-closed file
@@ -372,6 +379,26 @@
 	* sysdep.c (strlwr): Don't intermix declarations and code.
 	(wcslen): ditto
 
+2006-08-26  Adrian Aichner  <adrian@xemacs.org>
+
+	* eval.c (condition_case_1): GCPRO barg, instead of harg, before
+	calling (*bfun) (barg).
+	GCPRO harg before calling (*hfun) (c.val, harg).
+	GCPRO Lisp_Object members of local catchtag variable.
+
+2006-08-25  Adrian Aichner  <adrian@xemacs.org>
+
+	* gc.c: Comment out globals `backtrace' and `do_backtrace'.
+	* gc.c (gc_prepare): Add PROFILE_DECLARE and
+	PROFILE_RECORD_EXITING_SECTION.
+	* gc.c (gc_finish): Add PROFILE_DECLARE and
+	PROFILE_RECORD_ENTERING_SECTION.
+	* gc.c (gc_suspend_mark_phase): Add PROFILE_DECLARE and
+	PROFILE_RECORD_ENTERING_SECTION, move
+	PROFILE_RECORD_EXITING_SECTION to end.
+	* gc.c (gc_resume_mark_phase): Add PROFILE_DECLARE and
+	PROFILE_RECORD_EXITING_SECTION.
+
 2006-11-23  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* mule-coding.c (iso2022_decode):
--- a/src/abbrev.c	Sat May 19 18:04:19 2007 +0000
+++ b/src/abbrev.c	Sat May 19 18:42:17 2007 +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