emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r104442: * lisp/minibuffer.el: Add me


From: Stefan Monnier
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r104442: * lisp/minibuffer.el: Add metadata method to completion tables.
Date: Tue, 31 May 2011 00:03:38 -0300
User-agent: Bazaar (2.3.1)

------------------------------------------------------------
revno: 104442
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2011-05-31 00:03:38 -0300
message:
  * lisp/minibuffer.el: Add metadata method to completion tables.
  (completion-category-overrides): New defcustom.
  (completion-metadata, completion--field-metadata)
  (completion-metadata-get, completion--styles)
  (completion--cycle-threshold): New functions.
  (completion-try-completion, completion-all-completions):
  Add `metadata' argument to choose completion-styles.
  (completion--do-completion): Use metadata to choose cycling.
  (completion-all-sorted-completions): Use metadata for sorting.
  Remove :completion-cycle-penalty which is not needed any more.
  (completion--try-word-completion): Add `metadata' argument.
  (minibuffer-completion-help): Check metadata for annotation function
  and sorting.
  (completion-file-name-table): Return `category' metadata.
  (minibuffer-completing-file-name): Make obsolete.
  * lisp/simple.el (minibuffer-completing-symbol): Make obsolete.
  * lisp/icomplete.el (icomplete-completions): Pass new `metadata' param to
  completion-try-completion.
  * src/minibuf.c (Finternal_complete_buffer): Return `category' metadata.
  (read_minibuf): Use get_minibuffer.
  (syms_of_minibuf): Use DEFSYM.
  (Qmetadata): New var.
  * src/data.c (Qbuffer): Don't make it static.
  (syms_of_data): Use DEFSYM.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/icomplete.el
  lisp/minibuffer.el
  lisp/simple.el
  src/ChangeLog
  src/data.c
  src/minibuf.c
=== modified file 'etc/NEWS'
--- a/etc/NEWS  2011-05-29 00:45:00 +0000
+++ b/etc/NEWS  2011-05-31 03:03:38 +0000
@@ -91,6 +91,10 @@
 
 *** New completion style `substring'.
 
+*** Completion style can be set per-category `completion-category-overrides'.
+
+*** Completion of buffers now uses substring completion by default.
+
 *** `completing-read' can be customized using the new variable
 `completing-read-function'.
 
@@ -861,6 +865,14 @@
 
 *** completion-annotate-function is obsolete.
 
+*** New `metadata' method for completion tables.  The metadata thus returned
+can specify various details of the data returned by `all-completions':
+- `category' is the kind of objects returned (e.g., `buffer', `file', ...),
+  used to select a style in completion-category-overrides.
+- `annotation-function' to add annotations in *Completions*.
+- `display-sort-function' to specify how to sort entries in *Completions*.
+- `cycle-sort-function' to specify how to sort entries when cycling.
+
 ** `glyphless-char-display' can now distinguish between graphical and
 text terminal display, via a char-table entry that is a cons cell.
 

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-05-30 17:23:47 +0000
+++ b/lisp/ChangeLog    2011-05-31 03:03:38 +0000
@@ -1,3 +1,24 @@
+2011-05-31  Stefan Monnier  <address@hidden>
+
+       * minibuffer.el: Add metadata method to completion tables.
+       (completion-category-overrides): New defcustom.
+       (completion-metadata, completion--field-metadata)
+       (completion-metadata-get, completion--styles)
+       (completion--cycle-threshold): New functions.
+       (completion-try-completion, completion-all-completions):
+       Add `metadata' argument to choose completion-styles.
+       (completion--do-completion): Use metadata to choose cycling.
+       (completion-all-sorted-completions): Use metadata for sorting.
+       Remove :completion-cycle-penalty which is not needed any more.
+       (completion--try-word-completion): Add `metadata' argument.
+       (minibuffer-completion-help): Check metadata for annotation function
+       and sorting.
+       (completion-file-name-table): Return `category' metadata.
+       (minibuffer-completing-file-name): Make obsolete.
+       * simple.el (minibuffer-completing-symbol): Make obsolete.
+       * icomplete.el (icomplete-completions): Pass new `metadata' param to
+       completion-try-completion.
+
 2011-05-30  Stefan Monnier  <address@hidden>
 
        * mail/smtpmail.el (smtpmail-send-data): Add progress reporter.

=== modified file 'lisp/icomplete.el'
--- a/lisp/icomplete.el 2011-04-10 21:31:14 +0000
+++ b/lisp/icomplete.el 2011-05-31 03:03:38 +0000
@@ -287,6 +287,7 @@
 are exhibited within the square braces.)"
 
   (let* ((non-essential t)
+         (md (completion--field-metadata (field-beginning)))
         (comps (completion-all-sorted-completions))
          (last (if (consp comps) (last comps)))
          (base-size (cdr last))
@@ -299,11 +300,11 @@
       (let* ((most-try
               (if (and base-size (> base-size 0))
                   (completion-try-completion
-                   name candidates predicate (length name))
+                   name candidates predicate (length name) md)
                 ;; If the `comps' are 0-based, the result should be
                 ;; the same with `comps'.
                 (completion-try-completion
-                 name comps nil (length name))))
+                 name comps nil (length name) md)))
             (most (if (consp most-try) (car most-try)
                      (if most-try (car comps) "")))
              ;; Compare name and most, so we can determine if name is

=== modified file 'lisp/minibuffer.el'
--- a/lisp/minibuffer.el        2011-05-28 02:10:32 +0000
+++ b/lisp/minibuffer.el        2011-05-31 03:03:38 +0000
@@ -61,10 +61,7 @@
 ;; - for M-x, cycle-sort commands that have no key binding first.
 ;; - Make things like icomplete-mode or lightning-completion work with
 ;;   completion-in-region-mode.
-;; - extend `boundaries' to provide various other meta-data about the
-;;   output of `all-completions':
-;;   - preferred sorting order when displayed in *Completions*.
-;;   - annotations/text-properties to add when displayed in *Completions*.
+;; - extend `metadata':
 ;;   - quoting/unquoting (so we can complete files names with envvars
 ;;     and backslashes, and all-completion can list names without
 ;;     quoting backslashes and dollars).
@@ -116,6 +113,32 @@
     (cons (or (cadr boundaries) 0)
           (or (cddr boundaries) (length suffix)))))
 
+(defun completion-metadata (string table pred)
+  "Return the metadata of elements to complete at the end of STRING.
+This metadata is an alist.  Currently understood keys are:
+- `category': the kind of objects returned by `all-completions'.
+   Used by `completion-category-overrides'.
+- `annotation-function': function to add annotations in *Completions*.
+   Takes one argument (STRING), which is a possible completion and
+   returns a string to append to STRING.
+- `display-sort-function': function to sort entries in *Completions*.
+   Takes one argument (COMPLETIONS) and should return a new list
+   of completions.  Can operate destructively.
+- `cycle-sort-function': function to sort entries when cycling.
+   Works like `display-sort-function'."
+  (let ((metadata (if (functionp table)
+                      (funcall table string pred 'metadata))))
+    (if (eq (car-safe metadata) 'metadata)
+        (cdr metadata))))
+
+(defun completion--field-metadata (field-start)
+  (completion-metadata (buffer-substring-no-properties field-start (point))
+                       minibuffer-completion-table
+                       minibuffer-completion-predicate))
+
+(defun completion-metadata-get (metadata prop)
+  (cdr (assq prop metadata)))
+
 (defun completion--some (fun xs)
   "Apply FUN to each element of XS in turn.
 Return the first non-nil returned value.
@@ -457,7 +480,34 @@
   :group 'minibuffer
   :version "23.1")
 
-(defun completion-try-completion (string table pred point)
+(defcustom completion-category-overrides
+  '((buffer (styles . (basic substring))))
+  "List of overrides for specific categories.
+Each override has the shape (CATEGORY . ALIST) where ALIST is
+an association list that can specify properties such as:
+- `styles': the list of `completion-styles' to use for that category.
+- `cycle': the `completion-cycle-threshold' to use for that category."
+  :type `(alist :key-type (choice (const buffer)
+                                  (const file)
+                                  symbol)
+          :value-type
+          (set
+           (cons (const style)
+                 (repeat ,@(mapcar (lambda (x) (list 'const (car x)))
+                                   completion-styles-alist)))
+           (cons (const cycle)
+                 (choice (const :tag "No cycling" nil)
+                         (const :tag "Always cycle" t)
+                         (integer :tag "Threshold"))))))
+
+(defun completion--styles (metadata)
+  (let* ((cat (completion-metadata-get metadata 'category))
+         (over (assq 'styles (cdr (assq cat completion-category-overrides)))))
+    (if over
+        (delete-dups (append (cdr over) (copy-sequence completion-styles)))
+       completion-styles)))
+
+(defun completion-try-completion (string table pred point metadata)
   "Try to complete STRING using completion table TABLE.
 Only the elements of table that satisfy predicate PRED are considered.
 POINT is the position of point within STRING.
@@ -468,9 +518,9 @@
   (completion--some (lambda (style)
                       (funcall (nth 1 (assq style completion-styles-alist))
                                string table pred point))
-                    completion-styles))
+                    (completion--styles metadata)))
 
-(defun completion-all-completions (string table pred point)
+(defun completion-all-completions (string table pred point metadata)
   "List the possible completions of STRING in completion table TABLE.
 Only the elements of table that satisfy predicate PRED are considered.
 POINT is the position of point within STRING.
@@ -481,7 +531,7 @@
   (completion--some (lambda (style)
                       (funcall (nth 2 (assq style completion-styles-alist))
                                string table pred point))
-                    completion-styles))
+                    (completion--styles metadata)))
 
 (defun minibuffer--bitset (modified completions exact)
   (logior (if modified    4 0)
@@ -532,6 +582,11 @@
           (const :tag "Always cycle" t)
           (integer :tag "Threshold")))
 
+(defun completion--cycle-threshold (metadata)
+  (let* ((cat (completion-metadata-get metadata 'category))
+         (over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
+    (if over (cdr over) completion-cycle-threshold)))
+
 (defvar completion-all-sorted-completions nil)
 (make-variable-buffer-local 'completion-all-sorted-completions)
 (defvar completion-cycling nil)
@@ -566,12 +621,14 @@
   (let* ((beg (field-beginning))
          (end (field-end))
          (string (buffer-substring beg end))
+         (md (completion--field-metadata beg))
          (comp (funcall (or try-completion-function
                             'completion-try-completion)
                         string
                         minibuffer-completion-table
                         minibuffer-completion-predicate
-                        (- (point) beg))))
+                        (- (point) beg)
+                        md)))
     (cond
      ((null comp)
       (minibuffer-hide-completions)
@@ -610,16 +667,17 @@
             (completion--do-completion try-completion-function expect-exact)
 
           ;; It did find a match.  Do we match some possibility exactly now?
-          (let ((exact (test-completion completion
+          (let* ((exact (test-completion completion
                                         minibuffer-completion-table
                                         minibuffer-completion-predicate))
+                 (threshold (completion--cycle-threshold md))
                 (comps
                  ;; Check to see if we want to do cycling.  We do it
                  ;; here, after having performed the normal completion,
                  ;; so as to take advantage of the difference between
                  ;; try-completion and all-completions, for things
                  ;; like completion-ignored-extensions.
-                 (when (and completion-cycle-threshold
+                  (when (and threshold
                             ;; Check that the completion didn't make
                             ;; us jump to a different boundary.
                             (or (not completed)
@@ -636,7 +694,7 @@
                    (not (ignore-errors
                           ;; This signal an (intended) error if comps is too
                           ;; short or if completion-cycle-threshold is t.
-                          (consp (nthcdr completion-cycle-threshold comps)))))
+                          (consp (nthcdr threshold comps)))))
               ;; Fewer than completion-cycle-threshold remaining
               ;; completions: let's cycle.
               (setq completed t exact t)
@@ -715,27 +773,25 @@
   (or completion-all-sorted-completions
       (let* ((start (field-beginning))
              (end (field-end))
-             (all (completion-all-completions (buffer-substring start end)
-                                              minibuffer-completion-table
-                                              minibuffer-completion-predicate
-                                              (- (point) start)))
+             (string (buffer-substring start end))
+             (all (completion-all-completions
+                   string
+                   minibuffer-completion-table
+                   minibuffer-completion-predicate
+                   (- (point) start)
+                   (completion--field-metadata start)))
              (last (last all))
-             (base-size (or (cdr last) 0)))
+             (base-size (or (cdr last) 0))
+             (all-md (completion-metadata (substring string 0 base-size)
+                                          minibuffer-completion-table
+                                          minibuffer-completion-predicate))
+             (sort-fun (completion-metadata-get all-md 'cycle-sort-function)))
         (when last
           (setcdr last nil)
-          ;; Prefer shorter completions.
-          (setq all (sort all (lambda (c1 c2)
-                                (let ((s1 (get-text-property
-                                           0 :completion-cycle-penalty c1))
-                                      (s2 (get-text-property
-                                           0 :completion-cycle-penalty c2)))
-                                  (if (eq s1 s2)
-                                      (< (length c1) (length c2))
-                                    (< (or s1 (length c1))
-                                       (or s2 (length c2))))))))
+          (setq all (if sort-fun (funcall sort-fun all)
+                      ;; Prefer shorter completions, by default.
+                      (sort all (lambda (c1 c2) (< (length c1) (length c2))))))
           ;; Prefer recently used completions.
-          ;; FIXME: Additional sorting ideas:
-          ;; - for M-x, prefer commands that have no key binding.
           (when (minibufferp)
             (let ((hist (symbol-value minibuffer-history-variable)))
               (setq all (sort all (lambda (c1 c2)
@@ -758,6 +814,7 @@
   ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
   (let* ((start (field-beginning))
          (end (field-end))
+         ;; (md (completion--field-metadata start))
          (all (completion-all-sorted-completions))
          (base (+ start (or (cdr (last all)) 0))))
     (cond
@@ -861,8 +918,8 @@
                  nil))
         (t nil))))))
 
-(defun completion--try-word-completion (string table predicate point)
-  (let ((comp (completion-try-completion string table predicate point)))
+(defun completion--try-word-completion (string table predicate point md)
+  (let ((comp (completion-try-completion string table predicate point md)))
     (if (not (consp comp))
         comp
 
@@ -884,7 +941,7 @@
          (while (and exts (not (consp tem)))
             (setq tem (completion-try-completion
                       (concat before (pop exts) after)
-                      table predicate (1+ point))))
+                      table predicate (1+ point) md)))
          (if (consp tem) (setq comp tem))))
 
       ;; Completing a single word is actually more difficult than completing
@@ -1219,7 +1276,8 @@
                        string
                        minibuffer-completion-table
                        minibuffer-completion-predicate
-                       (- (point) (field-beginning)))))
+                       (- (point) (field-beginning))
+                       (completion--field-metadata start))))
     (message nil)
     (if (or (null completions)
             (and (not (consp (cdr completions)))
@@ -1235,9 +1293,16 @@
       (let* ((last (last completions))
              (base-size (cdr last))
              (prefix (unless (zerop base-size) (substring string 0 base-size)))
-             (global-af (or (plist-get completion-extra-properties
-                                       :annotation-function)
-                            completion-annotate-function))
+             ;; FIXME: This function is for the output of all-completions,
+             ;; not completion-all-completions.  Often it's the same, but
+             ;; not always.
+             (all-md (completion-metadata (substring string 0 base-size)
+                                          minibuffer-completion-table
+                                          minibuffer-completion-predicate))
+             (afun (or (completion-metadata-get all-md 'annotation-function)
+                       (plist-get completion-extra-properties
+                                  :annotation-function)
+                       completion-annotate-function))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
              ;; minibuffer-hide-completions will know whether to
@@ -1247,15 +1312,21 @@
           ;; Remove the base-size tail because `sort' requires a properly
           ;; nil-terminated list.
           (when last (setcdr last nil))
-          (setq completions (sort completions 'string-lessp))
           (setq completions
-                (cond
-                 (global-af
+                ;; FIXME: This function is for the output of all-completions,
+                ;; not completion-all-completions.  Often it's the same, but
+                ;; not always.
+                (let ((sort-fun (completion-metadata-get
+                                 all-md 'display-sort-function)))
+                  (if sort-fun
+                      (funcall sort-fun completions)
+                    (sort completions 'string-lessp))))
+          (when afun
+            (setq completions
                   (mapcar (lambda (s)
-                            (let ((ann (funcall global-af s)))
+                            (let ((ann (funcall afun s)))
                               (if ann (list s ann) s)))
-                          completions))
-                 (t completions)))
+                          completions)))
 
           (with-current-buffer standard-output
             (set (make-local-variable 'completion-base-position)
@@ -1270,12 +1341,12 @@
                        (cpred minibuffer-completion-predicate)
                        (cprops completion-extra-properties))
                    (lambda (start end choice)
-                     (unless
-                        (or (zerop (length prefix))
-                            (equal prefix
-                                   (buffer-substring-no-properties
-                                    (max (point-min) (- start (length prefix)))
-                                    start)))
+                     (unless (or (zerop (length prefix))
+                                 (equal prefix
+                                        (buffer-substring-no-properties
+                                         (max (point-min)
+                                              (- start (length prefix)))
+                                         start)))
                        (message "*Completions* out of date"))
                      ;; FIXME: Use `md' to do quoting&terminator here.
                      (completion--replace start end choice)
@@ -1632,6 +1703,7 @@
   "Completion table for file names."
   (ignore-errors
     (cond
+     ((eq action 'metadata) '(metadata (category . file)))
      ((eq (car-safe action) 'boundaries)
       (let ((start (length (file-name-directory string)))
             (end (string-match-p "/" (cdr action))))
@@ -1852,6 +1924,11 @@
   (funcall (or read-file-name-function #'read-file-name-default)
            prompt dir default-filename mustmatch initial predicate))
 
+;; minibuffer-completing-file-name is a variable used internally in minibuf.c
+;; to determine whether to use minibuffer-local-filename-completion-map or
+;; minibuffer-local-completion-map.  It shouldn't be exported to Elisp.
+(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1")
+
 (defun read-file-name-default (prompt &optional dir default-filename mustmatch 
initial predicate)
   "Default method for reading file names.
 See `read-file-name' for the meaning of the arguments."

=== modified file 'lisp/simple.el'
--- a/lisp/simple.el    2011-05-24 02:45:50 +0000
+++ b/lisp/simple.el    2011-05-31 03:03:38 +0000
@@ -1158,6 +1158,7 @@
 
 (defvar minibuffer-completing-symbol nil
   "Non-nil means completing a Lisp symbol in the minibuffer.")
+(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1")
 
 (defvar minibuffer-default nil
   "The current default value or list of default values in the minibuffer.

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2011-05-31 02:12:01 +0000
+++ b/src/ChangeLog     2011-05-31 03:03:38 +0000
@@ -1,3 +1,12 @@
+2011-05-31  Stefan Monnier  <address@hidden>
+
+       * minibuf.c (Finternal_complete_buffer): Return `category' metadata.
+       (read_minibuf): Use get_minibuffer.
+       (syms_of_minibuf): Use DEFSYM.
+       (Qmetadata): New var.
+       * data.c (Qbuffer): Don't make it static.
+       (syms_of_data): Use DEFSYM.
+
 2011-05-31  Paul Eggert  <address@hidden>
 
        * ccl.c (CCL_CODE_RANGE): Allow negative numbers.  (Bug#8751)
@@ -164,8 +173,8 @@
        (symbol_to_x_atom): Remove gratuitous arg.
        (x_handle_selection_request, lisp_data_to_selection_data)
        (x_get_foreign_selection, Fx_register_dnd_atom): Callers changed.
-       (x_own_selection, x_get_local_selection, x_convert_selection): New
-       arg, specifying work frame.  Use terminal-local Vselection_alist.
+       (x_own_selection, x_get_local_selection, x_convert_selection):
+       New arg, specifying work frame.  Use terminal-local Vselection_alist.
        (some_frame_on_display): Delete unused function.
        (Fx_own_selection_internal, Fx_get_selection_internal)
        (Fx_disown_selection_internal, Fx_selection_owner_p)
@@ -186,8 +195,8 @@
        (x_selection_request_lisp_error): Free the above.
        (x_get_local_selection): Remove unnecessary code.
        (x_reply_selection_request): Args changed; handle arbitrary array
-       of converted selections stored in converted_selections.  Separate
-       the XChangeProperty and SelectionNotify steps.
+       of converted selections stored in converted_selections.
+       Separate the XChangeProperty and SelectionNotify steps.
        (x_handle_selection_request): Rewrite to handle MULTIPLE target.
        (x_convert_selection): New function.
        (x_handle_selection_event): Simplify.
@@ -351,8 +360,8 @@
 
        Be more systematic about user-interface timestamps.
        Before, the code sometimes used 'Time', sometimes 'unsigned long',
-       and sometimes 'EMACS_UINT', to represent these timestamps.  This
-       change causes it to use 'Time' uniformly, as that's what X uses.
+       and sometimes 'EMACS_UINT', to represent these timestamps.
+       This change causes it to use 'Time' uniformly, as that's what X uses.
        This makes the code easier to follow, and makes it easier to catch
        integer overflow bugs such as Bug#8664.
        * frame.c (Fmouse_position, Fmouse_pixel_position):

=== modified file 'src/data.c'
--- a/src/data.c        2011-05-27 19:48:22 +0000
+++ b/src/data.c        2011-05-31 03:03:38 +0000
@@ -32,14 +32,14 @@
 #include "keyboard.h"
 #include "frame.h"
 #include "syssignal.h"
-#include "termhooks.h"  /* For FRAME_KBOARD reference in y-or-n-p. */
+#include "termhooks.h"  /* For FRAME_KBOARD reference in y-or-n-p.  */
 #include "font.h"
 
 #ifdef STDC_HEADERS
 #include <float.h>
 #endif
 
-/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
+/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*.  */
 #ifndef IEEE_FLOATING_POINT
 #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
      && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
@@ -90,7 +90,7 @@
 Lisp_Object Qwindow;
 static Lisp_Object Qfloat, Qwindow_configuration;
 static Lisp_Object Qprocess;
-static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
+Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
 static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
 static Lisp_Object Qsubrp, Qmany, Qunevalled;
 Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
@@ -2854,74 +2854,75 @@
 {
   Lisp_Object error_tail, arith_tail;
 
-  Qquote = intern_c_string ("quote");
-  Qlambda = intern_c_string ("lambda");
-  Qsubr = intern_c_string ("subr");
-  Qerror_conditions = intern_c_string ("error-conditions");
-  Qerror_message = intern_c_string ("error-message");
-  Qtop_level = intern_c_string ("top-level");
-
-  Qerror = intern_c_string ("error");
-  Qquit = intern_c_string ("quit");
-  Qwrong_type_argument = intern_c_string ("wrong-type-argument");
-  Qargs_out_of_range = intern_c_string ("args-out-of-range");
-  Qvoid_function = intern_c_string ("void-function");
-  Qcyclic_function_indirection = intern_c_string 
("cyclic-function-indirection");
-  Qcyclic_variable_indirection = intern_c_string 
("cyclic-variable-indirection");
-  Qvoid_variable = intern_c_string ("void-variable");
-  Qsetting_constant = intern_c_string ("setting-constant");
-  Qinvalid_read_syntax = intern_c_string ("invalid-read-syntax");
-
-  Qinvalid_function = intern_c_string ("invalid-function");
-  Qwrong_number_of_arguments = intern_c_string ("wrong-number-of-arguments");
-  Qno_catch = intern_c_string ("no-catch");
-  Qend_of_file = intern_c_string ("end-of-file");
-  Qarith_error = intern_c_string ("arith-error");
-  Qbeginning_of_buffer = intern_c_string ("beginning-of-buffer");
-  Qend_of_buffer = intern_c_string ("end-of-buffer");
-  Qbuffer_read_only = intern_c_string ("buffer-read-only");
-  Qtext_read_only = intern_c_string ("text-read-only");
-  Qmark_inactive = intern_c_string ("mark-inactive");
-
-  Qlistp = intern_c_string ("listp");
-  Qconsp = intern_c_string ("consp");
-  Qsymbolp = intern_c_string ("symbolp");
-  Qkeywordp = intern_c_string ("keywordp");
-  Qintegerp = intern_c_string ("integerp");
-  Qnatnump = intern_c_string ("natnump");
-  Qwholenump = intern_c_string ("wholenump");
-  Qstringp = intern_c_string ("stringp");
-  Qarrayp = intern_c_string ("arrayp");
-  Qsequencep = intern_c_string ("sequencep");
-  Qbufferp = intern_c_string ("bufferp");
-  Qvectorp = intern_c_string ("vectorp");
-  Qchar_or_string_p = intern_c_string ("char-or-string-p");
-  Qmarkerp = intern_c_string ("markerp");
-  Qbuffer_or_string_p = intern_c_string ("buffer-or-string-p");
-  Qinteger_or_marker_p = intern_c_string ("integer-or-marker-p");
-  Qboundp = intern_c_string ("boundp");
-  Qfboundp = intern_c_string ("fboundp");
-
-  Qfloatp = intern_c_string ("floatp");
-  Qnumberp = intern_c_string ("numberp");
-  Qnumber_or_marker_p = intern_c_string ("number-or-marker-p");
-
-  Qchar_table_p = intern_c_string ("char-table-p");
-  Qvector_or_char_table_p = intern_c_string ("vector-or-char-table-p");
-
-  Qsubrp = intern_c_string ("subrp");
-  Qunevalled = intern_c_string ("unevalled");
-  Qmany = intern_c_string ("many");
-
-  Qcdr = intern_c_string ("cdr");
-
-  /* Handle automatic advice activation */
-  Qad_advice_info = intern_c_string ("ad-advice-info");
-  Qad_activate_internal = intern_c_string ("ad-activate-internal");
+  DEFSYM (Qquote, "quote");
+  DEFSYM (Qlambda, "lambda");
+  DEFSYM (Qsubr, "subr");
+  DEFSYM (Qerror_conditions, "error-conditions");
+  DEFSYM (Qerror_message, "error-message");
+  DEFSYM (Qtop_level, "top-level");
+
+  DEFSYM (Qerror, "error");
+  DEFSYM (Qquit, "quit");
+  DEFSYM (Qwrong_type_argument, "wrong-type-argument");
+  DEFSYM (Qargs_out_of_range, "args-out-of-range");
+  DEFSYM (Qvoid_function, "void-function");
+  DEFSYM (Qcyclic_function_indirection, "cyclic-function-indirection");
+  DEFSYM (Qcyclic_variable_indirection, "cyclic-variable-indirection");
+  DEFSYM (Qvoid_variable, "void-variable");
+  DEFSYM (Qsetting_constant, "setting-constant");
+  DEFSYM (Qinvalid_read_syntax, "invalid-read-syntax");
+
+  DEFSYM (Qinvalid_function, "invalid-function");
+  DEFSYM (Qwrong_number_of_arguments, "wrong-number-of-arguments");
+  DEFSYM (Qno_catch, "no-catch");
+  DEFSYM (Qend_of_file, "end-of-file");
+  DEFSYM (Qarith_error, "arith-error");
+  DEFSYM (Qbeginning_of_buffer, "beginning-of-buffer");
+  DEFSYM (Qend_of_buffer, "end-of-buffer");
+  DEFSYM (Qbuffer_read_only, "buffer-read-only");
+  DEFSYM (Qtext_read_only, "text-read-only");
+  DEFSYM (Qmark_inactive, "mark-inactive");
+
+  DEFSYM (Qlistp, "listp");
+  DEFSYM (Qconsp, "consp");
+  DEFSYM (Qsymbolp, "symbolp");
+  DEFSYM (Qkeywordp, "keywordp");
+  DEFSYM (Qintegerp, "integerp");
+  DEFSYM (Qnatnump, "natnump");
+  DEFSYM (Qwholenump, "wholenump");
+  DEFSYM (Qstringp, "stringp");
+  DEFSYM (Qarrayp, "arrayp");
+  DEFSYM (Qsequencep, "sequencep");
+  DEFSYM (Qbufferp, "bufferp");
+  DEFSYM (Qvectorp, "vectorp");
+  DEFSYM (Qchar_or_string_p, "char-or-string-p");
+  DEFSYM (Qmarkerp, "markerp");
+  DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
+  DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
+  DEFSYM (Qboundp, "boundp");
+  DEFSYM (Qfboundp, "fboundp");
+
+  DEFSYM (Qfloatp, "floatp");
+  DEFSYM (Qnumberp, "numberp");
+  DEFSYM (Qnumber_or_marker_p, "number-or-marker-p");
+
+  DEFSYM (Qchar_table_p, "char-table-p");
+  DEFSYM (Qvector_or_char_table_p, "vector-or-char-table-p");
+
+  DEFSYM (Qsubrp, "subrp");
+  DEFSYM (Qunevalled, "unevalled");
+  DEFSYM (Qmany, "many");
+
+  DEFSYM (Qcdr, "cdr");
+
+  /* Handle automatic advice activation.  */
+  DEFSYM (Qad_advice_info, "ad-advice-info");
+  DEFSYM (Qad_activate_internal, "ad-activate-internal");
 
   error_tail = pure_cons (Qerror, Qnil);
 
-  /* ERROR is used as a signaler for random errors for which nothing else is 
right */
+  /* ERROR is used as a signaler for random errors for which nothing else is
+     right.  */
 
   Fput (Qerror, Qerror_conditions,
        error_tail);
@@ -2958,8 +2959,7 @@
   Fput (Qcyclic_variable_indirection, Qerror_message,
        make_pure_c_string ("Symbol's chain of variable indirections contains a 
loop"));
 
-  Qcircular_list = intern_c_string ("circular-list");
-  staticpro (&Qcircular_list);
+  DEFSYM (Qcircular_list, "circular-list");
   Fput (Qcircular_list, Qerror_conditions,
        pure_cons (Qcircular_list, error_tail));
   Fput (Qcircular_list, Qerror_message,
@@ -3026,11 +3026,11 @@
   Fput (Qtext_read_only, Qerror_message,
        make_pure_c_string ("Text is read-only"));
 
-  Qrange_error = intern_c_string ("range-error");
-  Qdomain_error = intern_c_string ("domain-error");
-  Qsingularity_error = intern_c_string ("singularity-error");
-  Qoverflow_error = intern_c_string ("overflow-error");
-  Qunderflow_error = intern_c_string ("underflow-error");
+  DEFSYM (Qrange_error, "range-error");
+  DEFSYM (Qdomain_error, "domain-error");
+  DEFSYM (Qsingularity_error, "singularity-error");
+  DEFSYM (Qoverflow_error, "overflow-error");
+  DEFSYM (Qunderflow_error, "underflow-error");
 
   Fput (Qdomain_error, Qerror_conditions,
        pure_cons (Qdomain_error, arith_tail));
@@ -3057,93 +3057,29 @@
   Fput (Qunderflow_error, Qerror_message,
        make_pure_c_string ("Arithmetic underflow error"));
 
-  staticpro (&Qrange_error);
-  staticpro (&Qdomain_error);
-  staticpro (&Qsingularity_error);
-  staticpro (&Qoverflow_error);
-  staticpro (&Qunderflow_error);
-
   staticpro (&Qnil);
   staticpro (&Qt);
-  staticpro (&Qquote);
-  staticpro (&Qlambda);
-  staticpro (&Qsubr);
   staticpro (&Qunbound);
-  staticpro (&Qerror_conditions);
-  staticpro (&Qerror_message);
-  staticpro (&Qtop_level);
-
-  staticpro (&Qerror);
-  staticpro (&Qquit);
-  staticpro (&Qwrong_type_argument);
-  staticpro (&Qargs_out_of_range);
-  staticpro (&Qvoid_function);
-  staticpro (&Qcyclic_function_indirection);
-  staticpro (&Qcyclic_variable_indirection);
-  staticpro (&Qvoid_variable);
-  staticpro (&Qsetting_constant);
-  staticpro (&Qinvalid_read_syntax);
-  staticpro (&Qwrong_number_of_arguments);
-  staticpro (&Qinvalid_function);
-  staticpro (&Qno_catch);
-  staticpro (&Qend_of_file);
-  staticpro (&Qarith_error);
-  staticpro (&Qbeginning_of_buffer);
-  staticpro (&Qend_of_buffer);
-  staticpro (&Qbuffer_read_only);
-  staticpro (&Qtext_read_only);
-  staticpro (&Qmark_inactive);
-
-  staticpro (&Qlistp);
-  staticpro (&Qconsp);
-  staticpro (&Qsymbolp);
-  staticpro (&Qkeywordp);
-  staticpro (&Qintegerp);
-  staticpro (&Qnatnump);
-  staticpro (&Qwholenump);
-  staticpro (&Qstringp);
-  staticpro (&Qarrayp);
-  staticpro (&Qsequencep);
-  staticpro (&Qbufferp);
-  staticpro (&Qvectorp);
-  staticpro (&Qchar_or_string_p);
-  staticpro (&Qmarkerp);
-  staticpro (&Qbuffer_or_string_p);
-  staticpro (&Qinteger_or_marker_p);
-  staticpro (&Qfloatp);
-  staticpro (&Qnumberp);
-  staticpro (&Qnumber_or_marker_p);
-  staticpro (&Qchar_table_p);
-  staticpro (&Qvector_or_char_table_p);
-  staticpro (&Qsubrp);
-  staticpro (&Qmany);
-  staticpro (&Qunevalled);
-
-  staticpro (&Qboundp);
-  staticpro (&Qfboundp);
-  staticpro (&Qcdr);
-  staticpro (&Qad_advice_info);
-  staticpro (&Qad_activate_internal);
 
   /* Types that type-of returns.  */
-  Qinteger = intern_c_string ("integer");
-  Qsymbol = intern_c_string ("symbol");
-  Qstring = intern_c_string ("string");
-  Qcons = intern_c_string ("cons");
-  Qmarker = intern_c_string ("marker");
-  Qoverlay = intern_c_string ("overlay");
-  Qfloat = intern_c_string ("float");
-  Qwindow_configuration = intern_c_string ("window-configuration");
-  Qprocess = intern_c_string ("process");
-  Qwindow = intern_c_string ("window");
-  /* Qsubr = intern_c_string ("subr"); */
-  Qcompiled_function = intern_c_string ("compiled-function");
-  Qbuffer = intern_c_string ("buffer");
-  Qframe = intern_c_string ("frame");
-  Qvector = intern_c_string ("vector");
-  Qchar_table = intern_c_string ("char-table");
-  Qbool_vector = intern_c_string ("bool-vector");
-  Qhash_table = intern_c_string ("hash-table");
+  DEFSYM (Qinteger, "integer");
+  DEFSYM (Qsymbol, "symbol");
+  DEFSYM (Qstring, "string");
+  DEFSYM (Qcons, "cons");
+  DEFSYM (Qmarker, "marker");
+  DEFSYM (Qoverlay, "overlay");
+  DEFSYM (Qfloat, "float");
+  DEFSYM (Qwindow_configuration, "window-configuration");
+  DEFSYM (Qprocess, "process");
+  DEFSYM (Qwindow, "window");
+  /* DEFSYM (Qsubr, "subr"); */
+  DEFSYM (Qcompiled_function, "compiled-function");
+  DEFSYM (Qbuffer, "buffer");
+  DEFSYM (Qframe, "frame");
+  DEFSYM (Qvector, "vector");
+  DEFSYM (Qchar_table, "char-table");
+  DEFSYM (Qbool_vector, "bool-vector");
+  DEFSYM (Qhash_table, "hash-table");
 
   DEFSYM (Qfont_spec, "font-spec");
   DEFSYM (Qfont_entity, "font-entity");
@@ -3151,25 +3087,6 @@
 
   DEFSYM (Qinteractive_form, "interactive-form");
 
-  staticpro (&Qinteger);
-  staticpro (&Qsymbol);
-  staticpro (&Qstring);
-  staticpro (&Qcons);
-  staticpro (&Qmarker);
-  staticpro (&Qoverlay);
-  staticpro (&Qfloat);
-  staticpro (&Qwindow_configuration);
-  staticpro (&Qprocess);
-  staticpro (&Qwindow);
-  /* staticpro (&Qsubr); */
-  staticpro (&Qcompiled_function);
-  staticpro (&Qbuffer);
-  staticpro (&Qframe);
-  staticpro (&Qvector);
-  staticpro (&Qchar_table);
-  staticpro (&Qbool_vector);
-  staticpro (&Qhash_table);
-
   defsubr (&Sindirect_variable);
   defsubr (&Sinteractive_form);
   defsubr (&Seq);

=== modified file 'src/minibuf.c'
--- a/src/minibuf.c     2011-05-12 07:07:06 +0000
+++ b/src/minibuf.c     2011-05-31 03:03:38 +0000
@@ -43,7 +43,7 @@
 
 Lisp_Object Vminibuffer_list;
 
-/* Data to remember during recursive minibuffer invocations  */
+/* Data to remember during recursive minibuffer invocations.  */
 
 static Lisp_Object minibuf_save_list;
 
@@ -55,7 +55,7 @@
 
 static Lisp_Object Qhistory_length;
 
-/* Fread_minibuffer leaves the input here as a string. */
+/* Fread_minibuffer leaves the input here as a string.  */
 
 Lisp_Object last_minibuf_string;
 
@@ -588,7 +588,7 @@
   /* Empty out the minibuffers of all frames other than the one
      where we are going to display one now.
      Set them to point to ` *Minibuf-0*', which is always empty.  */
-  empty_minibuf = Fget_buffer (build_string (" *Minibuf-0*"));
+  empty_minibuf = get_minibuffer (0);
 
   FOR_EACH_FRAME (dummy, frame)
     {
@@ -1137,8 +1137,8 @@
        }
 
       result = Fcompleting_read (prompt, intern ("internal-complete-buffer"),
-                                Qnil, require_match, Qnil, 
Qbuffer_name_history,
-                                def, Qnil);
+                                Qnil, require_match, Qnil,
+                                Qbuffer_name_history, def, Qnil);
     }
   else
     {
@@ -1878,6 +1878,9 @@
     return Qt;
 }
 
+Lisp_Object Qmetadata;
+extern Lisp_Object Qbuffer;
+
 DEFUN ("internal-complete-buffer", Finternal_complete_buffer, 
Sinternal_complete_buffer, 3, 3, 0,
        doc: /* Perform completion on buffer names.
 If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
@@ -1912,8 +1915,12 @@
          return res;
        }
     }
-  else                         /* assume `lambda' */
+  else if (EQ (flag, Qlambda))
     return Ftest_completion (string, Vbuffer_alist, predicate);
+  else if (EQ (flag, Qmetadata))
+    return Fcons (Qmetadata, Fcons (Fcons (Qcategory, Qbuffer), Qnil));
+  else
+    return Qnil;
 }
 
 /* Like assoc but assumes KEY is a string, and ignores case if appropriate.  */
@@ -1989,66 +1996,38 @@
   minibuf_save_list = Qnil;
   staticpro (&minibuf_save_list);
 
-  Qcompleting_read_default = intern_c_string ("completing-read-default");
-  staticpro (&Qcompleting_read_default);
-
-  Qcompletion_ignore_case = intern_c_string ("completion-ignore-case");
-  staticpro (&Qcompletion_ignore_case);
-
-  Qread_file_name_internal = intern_c_string ("read-file-name-internal");
-  staticpro (&Qread_file_name_internal);
-
-  Qminibuffer_default = intern_c_string ("minibuffer-default");
-  staticpro (&Qminibuffer_default);
+  DEFSYM (Qcompleting_read_default, "completing-read-default");
+  DEFSYM (Qcompletion_ignore_case, "completion-ignore-case");
+  DEFSYM (Qread_file_name_internal, "read-file-name-internal");
+  DEFSYM (Qminibuffer_default, "minibuffer-default");
   Fset (Qminibuffer_default, Qnil);
 
-  Qminibuffer_completion_table = intern_c_string 
("minibuffer-completion-table");
-  staticpro (&Qminibuffer_completion_table);
-
-  Qminibuffer_completion_confirm = intern_c_string 
("minibuffer-completion-confirm");
-  staticpro (&Qminibuffer_completion_confirm);
-
-  Qminibuffer_completion_predicate = intern_c_string 
("minibuffer-completion-predicate");
-  staticpro (&Qminibuffer_completion_predicate);
+  DEFSYM (Qminibuffer_completion_table, "minibuffer-completion-table");
+  DEFSYM (Qminibuffer_completion_confirm, "minibuffer-completion-confirm");
+  DEFSYM (Qminibuffer_completion_predicate, "minibuffer-completion-predicate");
 
   staticpro (&last_minibuf_string);
   last_minibuf_string = Qnil;
 
-  Quser_variable_p = intern_c_string ("user-variable-p");
-  staticpro (&Quser_variable_p);
-
-  Qminibuffer_history = intern_c_string ("minibuffer-history");
-  staticpro (&Qminibuffer_history);
-
-  Qbuffer_name_history = intern_c_string ("buffer-name-history");
-  staticpro (&Qbuffer_name_history);
+  DEFSYM (Quser_variable_p, "user-variable-p");
+  DEFSYM (Qminibuffer_history, "minibuffer-history");
+  DEFSYM (Qbuffer_name_history, "buffer-name-history");
   Fset (Qbuffer_name_history, Qnil);
 
-  Qminibuffer_setup_hook = intern_c_string ("minibuffer-setup-hook");
-  staticpro (&Qminibuffer_setup_hook);
-
-  Qminibuffer_exit_hook = intern_c_string ("minibuffer-exit-hook");
-  staticpro (&Qminibuffer_exit_hook);
-
-  Qhistory_length = intern_c_string ("history-length");
-  staticpro (&Qhistory_length);
-
-  Qcurrent_input_method = intern_c_string ("current-input-method");
-  staticpro (&Qcurrent_input_method);
-
-  Qactivate_input_method = intern_c_string ("activate-input-method");
-  staticpro (&Qactivate_input_method);
-
-  Qcase_fold_search = intern_c_string ("case-fold-search");
-  staticpro (&Qcase_fold_search);
+  DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook");
+  DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook");
+  DEFSYM (Qhistory_length, "history-length");
+  DEFSYM (Qcurrent_input_method, "current-input-method");
+  DEFSYM (Qactivate_input_method, "activate-input-method");
+  DEFSYM (Qcase_fold_search, "case-fold-search");
+  DEFSYM (Qmetadata, "metadata");
 
   DEFVAR_LISP ("read-expression-history", Vread_expression_history,
               doc: /* A history list for arguments that are Lisp expressions 
to evaluate.
 For example, `eval-expression' uses this.  */);
   Vread_expression_history = Qnil;
 
-  Qread_expression_history = intern_c_string ("read-expression-history");
-  staticpro (&Qread_expression_history);
+  DEFSYM (Qread_expression_history, "read-expression-history");
 
   DEFVAR_LISP ("read-buffer-function", Vread_buffer_function,
               doc: /* If this is non-nil, `read-buffer' does its work by 
calling this function.


reply via email to

[Prev in Thread] Current Thread [Next in Thread]