Mercurial > emacs

changeset 94300:b47239d57d36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* lisp/minibuffer.el (read-file-name-function, read-file-name-predicate) (read-file-name-completion-ignore-case, insert-default-directory): New vars, moved from fileio.c. (read-file-name): New fun, moved from fileio.c. * lisp/cus-start.el: Remove insert-default-directory and read-file-name-completion-ignore-case. * src/fileio.c (Vread_file_name_function, Vread_file_name_predicate) (read_file_name_completion_ignore_case, insert_default_directory) (Qdefault_directory): Move to minibuffer.el. (Fread_file_name): Call the new `read-file-name' instead.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 23 Apr 2008 18:19:57 +0000
parents c4b844d3df2c
children 9060af7294b9
files lisp/ChangeLog lisp/cus-start.el lisp/minibuffer.el src/ChangeLog src/fileio.c
diffstat 5 files changed, 170 insertions(+), 265 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Apr 23 18:01:46 2008 +0000
+++ b/lisp/ChangeLog	Wed Apr 23 18:19:57 2008 +0000
@@ -1,5 +1,12 @@
 2008-04-23  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* minibuffer.el (read-file-name-function, read-file-name-predicate)
+	(read-file-name-completion-ignore-case, insert-default-directory):
+	New vars, moved from fileio.c.
+	(read-file-name): New fun, moved from fileio.c.
+	* cus-start.el: Remove insert-default-directory and
+	read-file-name-completion-ignore-case.
+
 	* Makefile.in (emacs-deps): Leave it empty.
 
 2008-04-23  Magnus Henoch  <mange@freemail.hu>
--- a/lisp/cus-start.el	Wed Apr 23 18:01:46 2008 +0000
+++ b/lisp/cus-start.el	Wed Apr 23 18:19:57 2008 +0000
@@ -164,9 +164,6 @@
 					    :value (nil)
 					    (symbol :format "%v"))
 				    (const :tag "always" t)))
-	     ;; fileio.c
-	     (insert-default-directory minibuffer boolean)
-	     (read-file-name-completion-ignore-case minibuffer boolean "22.1")
 	     ;; fns.c
 	     (use-dialog-box menu boolean "21.1")
 	     (use-file-dialog menu boolean "22.1")
--- a/lisp/minibuffer.el	Wed Apr 23 18:01:46 2008 +0000
+++ b/lisp/minibuffer.el	Wed Apr 23 18:19:57 2008 +0000
@@ -764,6 +764,151 @@
                             'completion--file-name-table)
   "Internal subroutine for `read-file-name'.  Do not call this.")
 
+(defvar read-file-name-function nil
+  "If this is non-nil, `read-file-name' does its work by calling this function.")
+
+(defvar read-file-name-predicate nil
+  "Current predicate used by `read-file-name-internal'.")
+
+(defcustom read-file-name-completion-ignore-case
+  (if (memq system-type '(ms-dos windows-nt darwin macos vax-vms axp-vms))
+      t nil)
+  "Non-nil means when reading a file name completion ignores case."
+  :group 'minibuffer
+  :type 'boolean
+  :version "22.1")
+
+(defcustom insert-default-directory t
+  "Non-nil means when reading a filename start with default dir in minibuffer.
+
+When the initial minibuffer contents show a name of a file or a directory,
+typing RETURN without editing the initial contents is equivalent to typing
+the default file name.
+
+If this variable is non-nil, the minibuffer contents are always
+initially non-empty, and typing RETURN without editing will fetch the
+default name, if one is provided.  Note however that this default name
+is not necessarily the same as initial contents inserted in the minibuffer,
+if the initial contents is just the default directory.
+
+If this variable is nil, the minibuffer often starts out empty.  In
+that case you may have to explicitly fetch the next history element to
+request the default name; typing RETURN without editing will leave
+the minibuffer empty.
+
+For some commands, exiting with an empty minibuffer has a special meaning,
+such as making the current buffer visit no file in the case of
+`set-visited-file-name'."
+  :group 'minibuffer
+  :type 'boolean)
+
+(defun read-file-name (prompt &optional dir default-filename mustmatch initial predicate)
+  "Read file name, prompting with PROMPT and completing in directory DIR.
+Value is not expanded---you must call `expand-file-name' yourself.
+Default name to DEFAULT-FILENAME if user exits the minibuffer with
+the same non-empty string that was inserted by this function.
+ (If DEFAULT-FILENAME is omitted, the visited file name is used,
+  except that if INITIAL is specified, that combined with DIR is used.)
+If the user exits with an empty minibuffer, this function returns
+an empty string.  (This can only happen if the user erased the
+pre-inserted contents or if `insert-default-directory' is nil.)
+Fourth arg MUSTMATCH non-nil means require existing file's name.
+ Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL specifies text to start with.
+If optional sixth arg PREDICATE is non-nil, possible completions and
+the resulting file name must satisfy (funcall PREDICATE NAME).
+DIR should be an absolute directory name.  It defaults to the value of
+`default-directory'.
+
+If this command was invoked with the mouse, use a file dialog box if
+`use-dialog-box' is non-nil, and the window system or X toolkit in use
+provides a file dialog box.
+
+See also `read-file-name-completion-ignore-case'
+and `read-file-name-function'."
+  (unless dir (setq dir default-directory))
+  (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir)))
+  (unless default-filename
+    (setq default-filename (if initial (expand-file-name initial dir)
+                             buffer-file-name)))
+  ;; If dir starts with user's homedir, change that to ~.
+  (setq dir (abbreviate-file-name dir))
+  ;; Likewise for default-filename.
+  (setq default-filename (abbreviate-file-name default-filename))
+  (let ((insdef (cond
+                 ((and insert-default-directory (stringp dir))
+                  (if initial
+                      (cons (minibuffer--double-dollars (concat dir initial))
+                            (length (minibuffer--double-dollars dir)))
+                    (minibuffer--double-dollars dir)))
+                 (initial (cons (minibuffer--double-dollars initial) 0)))))
+
+    (if read-file-name-function
+        (funcall read-file-name-function
+                 prompt dir default-filename mustmatch initial predicate)
+      (let ((default-directory (file-name-as-directory (expand-file-name dir)))
+            (completion-ignore-case read-file-name-completion-ignore-case)
+            (minibuffer-completing-file-name t)
+            (read-file-name-predicate (or predicate 'file-exists-p))
+            (add-to-history nil))
+
+        (let* ((val
+                (if (not (next-read-file-uses-dialog-p))
+                    (completing-read prompt 'read-file-name-internal
+                                     nil mustmatch insdef 'file-name-history
+                                     default-filename)
+                  ;; If DIR contains a file name, split it.
+                  (let ((file (file-name-nondirectory dir)))
+                    (when (and default-filename (not (zerop (length file))))
+                      (setq default-filename file)
+                      (setq dir (file-name-directory dir)))
+                    (if default-filename
+                        (setq default-filename
+                              (expand-file-name default-filename dir)))
+                    (setq add-to-history t)
+                    (x-file-dialog prompt dir default-filename mustmatch
+                                   (eq predicate 'file-directory-p)))))
+
+               (replace-in-history (eq (car-safe file-name-history) val)))
+          ;; If completing-read returned the inserted default string itself
+          ;; (rather than a new string with the same contents),
+          ;; it has to mean that the user typed RET with the minibuffer empty.
+          ;; In that case, we really want to return ""
+          ;; so that commands such as set-visited-file-name can distinguish.
+          (when (eq val default-filename)
+            ;; In this case, completing-read has not added an element
+            ;; to the history.  Maybe we should.
+            (if (not replace-in-history)
+                (setq add-to-history t))
+            (setq val ""))
+          (unless val (error "No file name specified"))
+
+          (if (and default-filename
+                   (string-equal val (if (consp insdef) (car insdef) insdef)))
+              (setq val default-filename))
+          (setq val (substitute-in-file-name val))
+
+          (if replace-in-history
+              ;; Replace what Fcompleting_read added to the history
+              ;; with what we will actually return.
+              (let ((val1 (minibuffer--double-dollars val)))
+                (if history-delete-duplicates
+                    (setcdr file-name-history
+                            (delete val1 (cdr file-name-history))))
+                (setcar file-name-history val1))
+            (if add-to-history
+                ;; Add the value to the history--but not if it matches
+                ;; the last value already there.
+                (let ((val1 (minibuffer--double-dollars val)))
+                  (unless (and (consp file-name-history)
+                               (equal (car file-name-history) val1))
+                    (setq file-name-history
+                          (cons val1
+                                (if history-delete-duplicates
+                                    (delete val1 file-name-history)
+                                  file-name-history)))))))
+          val)))))
+
 (defun internal-complete-buffer-except (&optional buffer)
   "Perform completion on all buffers excluding BUFFER.
 Like `internal-complete-buffer', but removes BUFFER from the completion list."
--- a/src/ChangeLog	Wed Apr 23 18:01:46 2008 +0000
+++ b/src/ChangeLog	Wed Apr 23 18:19:57 2008 +0000
@@ -1,3 +1,10 @@
+2008-04-23  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* fileio.c (Vread_file_name_function, Vread_file_name_predicate)
+	(read_file_name_completion_ignore_case, insert_default_directory)
+	(Qdefault_directory): Move to minibuffer.el.
+	(Fread_file_name): Call the new `read-file-name' instead.
+
 2008-04-19  YAMAMOTO Mitsuharu  <mituharu@math.s.chiba-u.ac.jp>
 
 	* mac.c (create_apple_event) [TARGET_API_MAC_CARBON]:
--- a/src/fileio.c	Wed Apr 23 18:01:46 2008 +0000
+++ b/src/fileio.c	Wed Apr 23 18:19:57 2008 +0000
@@ -207,19 +207,6 @@
 /* File name in which we write a list of all our auto save files.  */
 Lisp_Object Vauto_save_list_file_name;
 
-/* Function to call to read a file name.  */
-Lisp_Object Vread_file_name_function;
-
-/* Current predicate used by read_file_name_internal.  */
-Lisp_Object Vread_file_name_predicate;
-
-/* Nonzero means completion ignores case when reading file name.  */
-int read_file_name_completion_ignore_case;
-
-/* Nonzero means, when reading a filename in the minibuffer,
- start out by inserting the default directory into the minibuffer. */
-int insert_default_directory;
-
 /* On VMS, nonzero means write new files with record format stmlf.
    Zero means use var format.  */
 int vms_stmlf_recfm;
@@ -6156,218 +6143,22 @@
   return Qnil;
 }
 
-Lisp_Object Qdefault_directory;
-
-DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0,
-       doc: /* Read file name, prompting with PROMPT and completing in directory DIR.
-Value is not expanded---you must call `expand-file-name' yourself.
-Default name to DEFAULT-FILENAME if user exits the minibuffer with
-the same non-empty string that was inserted by this function.
- (If DEFAULT-FILENAME is omitted, the visited file name is used,
-  except that if INITIAL is specified, that combined with DIR is used.)
-If the user exits with an empty minibuffer, this function returns
-an empty string.  (This can only happen if the user erased the
-pre-inserted contents or if `insert-default-directory' is nil.)
-Fourth arg MUSTMATCH non-nil means require existing file's name.
- Non-nil and non-t means also require confirmation after completion.
-Fifth arg INITIAL specifies text to start with.
-If optional sixth arg PREDICATE is non-nil, possible completions and
-the resulting file name must satisfy (funcall PREDICATE NAME).
-DIR should be an absolute directory name.  It defaults to the value of
-`default-directory'.
-
-If this command was invoked with the mouse, use a file dialog box if
-`use-dialog-box' is non-nil, and the window system or X toolkit in use
-provides a file dialog box.
-
-See also `read-file-name-completion-ignore-case'
-and `read-file-name-function'.  */)
-     (prompt, dir, default_filename, mustmatch, initial, predicate)
+Lisp_Object
+Fread_file_name (prompt, dir, default_filename, mustmatch, initial, predicate)
      Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate;
 {
-  Lisp_Object val, insdef, tem;
   struct gcpro gcpro1, gcpro2;
-  register char *homedir;
-  Lisp_Object decoded_homedir;
-  int replace_in_history = 0;
-  int add_to_history = 0;
-  int count;
-
-  if (NILP (dir))
-    dir = current_buffer->directory;
-  if (NILP (Ffile_name_absolute_p (dir)))
-    dir = Fexpand_file_name (dir, Qnil);
-  if (NILP (default_filename))
-    default_filename
-      = (!NILP (initial)
-	 ? Fexpand_file_name (initial, dir)
-	 : current_buffer->filename);
-
-  /* If dir starts with user's homedir, change that to ~. */
-  homedir = (char *) egetenv ("HOME");
-#ifdef DOS_NT
-  /* homedir can be NULL in temacs, since Vglobal_environment is not
-     yet set up.  We shouldn't crash in that case.  */
-  if (homedir != 0)
-    {
-      homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
-      CORRECT_DIR_SEPS (homedir);
-    }
-#endif
-  if (homedir != 0)
-    decoded_homedir
-      = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir)));
-  if (homedir != 0
-      && STRINGP (dir)
-      && !strncmp (SDATA (decoded_homedir), SDATA (dir),
-		   SBYTES (decoded_homedir))
-      && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir))))
-    {
-      dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil);
-      dir = concat2 (build_string ("~"), dir);
-    }
-  /* Likewise for default_filename.  */
-  if (homedir != 0
-      && STRINGP (default_filename)
-      && !strncmp (SDATA (decoded_homedir), SDATA (default_filename),
-		   SBYTES (decoded_homedir))
-      && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir))))
-    {
-      default_filename
-	= Fsubstring (default_filename,
-		      make_number (SCHARS (decoded_homedir)), Qnil);
-      default_filename = concat2 (build_string ("~"), default_filename);
-    }
-  if (!NILP (default_filename))
-    {
-      CHECK_STRING (default_filename);
-      default_filename = double_dollars (default_filename);
-    }
-
-  if (insert_default_directory && STRINGP (dir))
-    {
-      insdef = dir;
-      if (!NILP (initial))
-	{
-	  Lisp_Object args[2], pos;
-
-	  args[0] = insdef;
-	  args[1] = initial;
-	  insdef = Fconcat (2, args);
-	  pos = make_number (SCHARS (double_dollars (dir)));
-	  insdef = Fcons (double_dollars (insdef), pos);
-	}
-      else
-	insdef = double_dollars (insdef);
-    }
-  else if (STRINGP (initial))
-    insdef = Fcons (double_dollars (initial), make_number (0));
-  else
-    insdef = Qnil;
-
-  if (!NILP (Vread_file_name_function))
-    {
-      Lisp_Object args[7];
-
-      GCPRO2 (insdef, default_filename);
-      args[0] = Vread_file_name_function;
-      args[1] = prompt;
-      args[2] = dir;
-      args[3] = default_filename;
-      args[4] = mustmatch;
-      args[5] = initial;
-      args[6] = predicate;
-      RETURN_UNGCPRO (Ffuncall (7, args));
-    }
-
-  count = SPECPDL_INDEX ();
-  specbind (Qdefault_directory,
-	    Ffile_name_as_directory (Fexpand_file_name (dir, Qnil)));
-  specbind (Qcompletion_ignore_case,
-	    read_file_name_completion_ignore_case ? Qt : Qnil);
-  specbind (intern ("minibuffer-completing-file-name"), Qt);
-  specbind (intern ("read-file-name-predicate"),
-	    (NILP (predicate) ? Qfile_exists_p : predicate));
+  Lisp_Object args[7];
 
   GCPRO2 (insdef, default_filename);
-
-#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
-  if (! NILP (Fnext_read_file_uses_dialog_p ()))
-    {
-      /* If DIR contains a file name, split it.  */
-      Lisp_Object file;
-      file = Ffile_name_nondirectory (dir);
-      if (SCHARS (file) && NILP (default_filename))
-	{
-	  default_filename = file;
-	  dir = Ffile_name_directory (dir);
-	}
-      if (!NILP(default_filename))
-        default_filename = Fexpand_file_name (default_filename, dir);
-      val = Fx_file_dialog (prompt, dir, default_filename, mustmatch,
-                            EQ (predicate, Qfile_directory_p) ? Qt : Qnil);
-      add_to_history = 1;
-    }
-  else
-#endif
-    val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
-			    Qnil, mustmatch, insdef,
-			    Qfile_name_history, default_filename, Qnil);
-
-  tem = Fsymbol_value (Qfile_name_history);
-  if (CONSP (tem) && EQ (XCAR (tem), val))
-    replace_in_history = 1;
-
-  /* If Fcompleting_read returned the inserted default string itself
-     (rather than a new string with the same contents),
-     it has to mean that the user typed RET with the minibuffer empty.
-     In that case, we really want to return ""
-     so that commands such as set-visited-file-name can distinguish.  */
-  if (EQ (val, default_filename))
-    {
-      /* In this case, Fcompleting_read has not added an element
-	 to the history.  Maybe we should.  */
-      if (! replace_in_history)
-	add_to_history = 1;
-
-      val = empty_unibyte_string;
-    }
-
-  unbind_to (count, Qnil);
-  UNGCPRO;
-  if (NILP (val))
-    error ("No file name specified");
-
-  tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef);
-
-  if (!NILP (tem) && !NILP (default_filename))
-    val = default_filename;
-  val = Fsubstitute_in_file_name (val);
-
-  if (replace_in_history)
-    /* Replace what Fcompleting_read added to the history
-       with what we will actually return.  */
-    {
-       Lisp_Object val1 = double_dollars (val);
-       tem = Fsymbol_value (Qfile_name_history);
-       if (history_delete_duplicates)
-	 XSETCDR (tem, Fdelete (val1, XCDR(tem)));
-       XSETCAR (tem, val1);
-    }
-  else if (add_to_history)
-    {
-      /* Add the value to the history--but not if it matches
-	 the last value already there.  */
-      Lisp_Object val1 = double_dollars (val);
-      tem = Fsymbol_value (Qfile_name_history);
-      if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1)))
-	{
-	  if (history_delete_duplicates) tem = Fdelete (val1, tem);
-	  Fset (Qfile_name_history, Fcons (val1, tem));
-	}
-    }
-
-  return val;
+  args[0] = intern ("read-file-name");
+  args[1] = prompt;
+  args[2] = dir;
+  args[3] = default_filename;
+  args[4] = mustmatch;
+  args[5] = initial;
+  args[6] = predicate;
+  RETURN_UNGCPRO (Ffuncall (7, args));
 }
 
 
@@ -6488,8 +6279,6 @@
 
   Qformat_decode = intern ("format-decode");
   staticpro (&Qformat_decode);
-  Qdefault_directory = intern ("default-directory");
-  staticpro (&Qdefault_directory);
   Qformat_annotate_function = intern ("format-annotate-function");
   staticpro (&Qformat_annotate_function);
   Qafter_insert_file_set_coding = intern ("after-insert-file-set-coding");
@@ -6513,45 +6302,6 @@
   Fput (Qfile_date_error, Qerror_message,
 	build_string ("Cannot set file date"));
 
-  DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function,
-	       doc: /* If this is non-nil, `read-file-name' does its work by calling this function.  */);
-  Vread_file_name_function = Qnil;
-
-  DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate,
-	       doc: /* Current predicate used by `read-file-name-internal'.  */);
-  Vread_file_name_predicate = Qnil;
-
-  DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case,
-	       doc: /* *Non-nil means when reading a file name completion ignores case.  */);
-#if defined VMS || defined DOS_NT || defined MAC_OS
-  read_file_name_completion_ignore_case = 1;
-#else
-  read_file_name_completion_ignore_case = 0;
-#endif
-
-  DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
-	       doc: /* *Non-nil means when reading a filename start with default dir in minibuffer.
-
-When the initial minibuffer contents show a name of a file or a directory,
-typing RETURN without editing the initial contents is equivalent to typing
-the default file name.
-
-If this variable is non-nil, the minibuffer contents are always
-initially non-empty, and typing RETURN without editing will fetch the
-default name, if one is provided.  Note however that this default name
-is not necessarily the same as initial contents inserted in the minibuffer,
-if the initial contents is just the default directory.
-
-If this variable is nil, the minibuffer often starts out empty.  In
-that case you may have to explicitly fetch the next history element to
-request the default name; typing RETURN without editing will leave
-the minibuffer empty.
-
-For some commands, exiting with an empty minibuffer has a special meaning,
-such as making the current buffer visit no file in the case of
-`set-visited-file-name'.  */);
-  insert_default_directory = 1;
-
   DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
 	       doc: /* *Non-nil means write new files with record format `stmlf'.
 nil means use format `var'.  This variable is meaningful only on VMS.  */);
@@ -6698,7 +6448,6 @@
   defsubr (&Sclear_buffer_auto_save_failure);
   defsubr (&Srecent_auto_save_p);
 
-  defsubr (&Sread_file_name);
   defsubr (&Snext_read_file_uses_dialog_p);
 
 #ifdef HAVE_SYNC