From 65821e224463a3d39034b7f31d54baf229a26e81 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 5 Feb 2011 23:59:06 -0500 Subject: * lisp/files.el (copy-directory): New arg COPY-AS-SUBDIR. If nil, don't copy as a subdirectory. --- lisp/files.el | 53 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 31 insertions(+), 22 deletions(-) (limited to 'lisp/files.el') diff --git a/lisp/files.el b/lisp/files.el index d896020b27b..7ac88f88851 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4723,21 +4723,23 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well." directory 'full directory-files-no-dot-files-regexp))) (delete-directory-internal directory))))) -(defun copy-directory (directory newname &optional keep-time parents) +(defun copy-directory (directory newname &optional keep-time + parents copy-as-subdir) "Copy DIRECTORY to NEWNAME. Both args must be strings. -If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there. - This function always sets the file modes of the output files to match the corresponding input file. The third arg KEEP-TIME non-nil means give the output files the same last-modified time as the old ones. (This works on only some systems.) - A prefix arg makes KEEP-TIME non-nil. -Noninteractively, the last argument PARENTS says whether to -create parent directories if they don't exist. Interactively, -this happens by default." +Optional arg PARENTS says whether to create parent directories if +they don't exist. When called interactively, PARENTS is t. + +When NEWNAME is an existing directory, copy DIRECTORY into a +subdirectory of NEWNAME if optional arg COPY-AS-SUBDIR is +non-nil, otherwise copy the contents of DIRECTORY into NEWNAME. +When called interactively, copy into a subdirectory by default." (interactive (let ((dir (read-directory-name "Copy directory: " default-directory default-directory t nil))) @@ -4745,7 +4747,7 @@ this happens by default." (read-file-name (format "Copy directory %s to: " dir) default-directory default-directory nil nil) - current-prefix-arg t))) + current-prefix-arg t t))) ;; If default-directory is a remote directory, make sure we find its ;; copy-directory handler. (let ((handler (or (find-file-name-handler directory 'copy-directory) @@ -4757,12 +4759,17 @@ this happens by default." (setq directory (directory-file-name (expand-file-name directory)) newname (directory-file-name (expand-file-name newname))) - (if (not (file-directory-p newname)) - ;; If NEWNAME is not an existing directory, create it; that - ;; is where we will copy the files of DIRECTORY. - (make-directory newname parents) - ;; If NEWNAME is an existing directory, we will copy into - ;; NEWNAME/[DIRECTORY-BASENAME]. + (unless (file-directory-p directory) + (error "%s is not a directory" directory)) + + (cond + ((not (file-directory-p newname)) + ;; If NEWNAME is not an existing directory, create it; + ;; that is where we will copy the files of DIRECTORY. + (make-directory newname parents)) + (copy-as-subdir + ;; If NEWNAME is an existing directory, and we are copying as + ;; a subdirectory, the target is NEWNAME/[DIRECTORY-BASENAME]. (setq newname (expand-file-name (file-name-nondirectory (directory-file-name directory)) @@ -4771,20 +4778,22 @@ this happens by default." (not (file-directory-p newname)) (error "Cannot overwrite non-directory %s with a directory" newname)) - (make-directory newname t)) + (make-directory newname t))) ;; Copy recursively. (dolist (file ;; We do not want to copy "." and "..". (directory-files directory 'full directory-files-no-dot-files-regexp)) - (if (file-directory-p file) - (copy-directory file newname keep-time parents) - (let ((target (expand-file-name (file-name-nondirectory file) newname)) - (attrs (file-attributes file))) - (if (stringp (car attrs)) ; Symbolic link - (make-symbolic-link (car attrs) target t) - (copy-file file target t keep-time))))) + (let ((target (expand-file-name + (file-name-nondirectory file) newname)) + (attrs (file-attributes file))) + (cond ((file-directory-p file) + (copy-directory file target keep-time parents nil)) + ((stringp (car attrs)) ; Symbolic link + (make-symbolic-link (car attrs) target t)) + (t + (copy-file file target t keep-time))))) ;; Set directory attributes. (set-file-modes newname (file-modes directory)) -- cgit v1.2.3 From 75d1d833f5273724839fdf46543d6b0920695700 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Fri, 11 Feb 2011 18:35:37 +0100 Subject: Save unmodified buffers when buffer-file-name doesn't exist. * files.el (basic-save-buffer): save unmodified buffers when the file pointed by buffer-file-name doesn't exist. --- lisp/ChangeLog | 5 +++++ lisp/files.el | 6 +++++- 2 files changed, 10 insertions(+), 1 deletion(-) (limited to 'lisp/files.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b3735e37289..043c8bebea6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-02-11 Bastien Guerry + + * files.el (basic-save-buffer): save unmodified buffers when + the file pointed by buffer-file-name doesn't exist. + 2011-02-11 Deniz Dogan * net/rcirc.el (defun-rcirc-join): Accept multiple channels. diff --git a/lisp/files.el b/lisp/files.el index 8b42eaaddb8..43b31cb0a7a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4309,7 +4309,11 @@ Before and after saving the buffer, this function runs ;; In an indirect buffer, save its base buffer instead. (if (buffer-base-buffer) (set-buffer (buffer-base-buffer))) - (if (buffer-modified-p) + (if (or (buffer-modified-p) + ;; handle the case when no modification has been made but + ;; the file disappeared since visited + (and buffer-file-name + (not (file-exists-p buffer-file-name)))) (let ((recent-save (recent-auto-save-p)) setmodes) ;; If buffer has no file name, ask user for one. -- cgit v1.2.3 From 470d996db4b850a0c4676e03de805e53703b80e0 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Sat, 12 Feb 2011 14:34:50 -0500 Subject: New optional arg COPY-CONTENTS to copy-directory. * files.el (copy-directory): New argument COPY-CONTENTS for copying directory contents into another existing directory. --- etc/NEWS | 5 +++++ lisp/ChangeLog | 5 +++++ lisp/files.el | 44 ++++++++++++++++++++++++-------------------- 3 files changed, 34 insertions(+), 20 deletions(-) (limited to 'lisp/files.el') diff --git a/etc/NEWS b/etc/NEWS index 11425c21342..6e9171e55c8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -633,6 +633,11 @@ Notifications API. It requires D-Bus for communication. * Incompatible Lisp Changes in Emacs 24.1 +** `copy-directory' now copies the source directory as a subdirectory +of the target directory, if the latter is an existing directory. The +new optional arg COPY-CONTENTS, if non-nil, makes the function copy +the contents directly into a pre-existing target directory. + ** `compose-mail' now accepts an optional 8th arg, RETURN-ACTION, and passes it to the mail user agent function. This argument specifies an action for returning to the caller after finishing with the mail. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e1bc8b94564..e80de4e9175 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-02-12 Thierry Volpiatto + + * files.el (copy-directory): New argument COPY-CONTENTS for + copying directory contents into another existing directory. + 2011-02-12 Tassilo Horn * minibuffer.el (completion-table-case-fold): New function for diff --git a/lisp/files.el b/lisp/files.el index 43b31cb0a7a..2d3dbc67d72 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4826,10 +4826,8 @@ given. With a prefix argument, TRASH is nil." directory 'full directory-files-no-dot-files-regexp))) (delete-directory-internal directory))))) -(defun copy-directory (directory newname &optional keep-time parents) +(defun copy-directory (directory newname &optional keep-time parents copy-contents) "Copy DIRECTORY to NEWNAME. Both args must be strings. -If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there. - This function always sets the file modes of the output files to match the corresponding input file. @@ -4840,7 +4838,12 @@ A prefix arg makes KEEP-TIME non-nil. Noninteractively, the last argument PARENTS says whether to create parent directories if they don't exist. Interactively, -this happens by default." +this happens by default. + +If NEWNAME names an existing directory, copy DIRECTORY as a +subdirectory there. However, if called from Lisp with a non-nil +optional argument COPY-CONTENTS, copy the contents of DIRECTORY +directly into NEWNAME instead." (interactive (let ((dir (read-directory-name "Copy directory: " default-directory default-directory t nil))) @@ -4848,7 +4851,7 @@ this happens by default." (read-file-name (format "Copy directory %s to: " dir) default-directory default-directory nil nil) - current-prefix-arg t))) + current-prefix-arg t nil))) ;; If default-directory is a remote directory, make sure we find its ;; copy-directory handler. (let ((handler (or (find-file-name-handler directory 'copy-directory) @@ -4860,21 +4863,22 @@ this happens by default." (setq directory (directory-file-name (expand-file-name directory)) newname (directory-file-name (expand-file-name newname))) - (if (not (file-directory-p newname)) - ;; If NEWNAME is not an existing directory, create it; that - ;; is where we will copy the files of DIRECTORY. - (make-directory newname parents) - ;; If NEWNAME is an existing directory, we will copy into - ;; NEWNAME/[DIRECTORY-BASENAME]. - (setq newname (expand-file-name - (file-name-nondirectory - (directory-file-name directory)) - newname)) - (and (file-exists-p newname) - (not (file-directory-p newname)) - (error "Cannot overwrite non-directory %s with a directory" - newname)) - (make-directory newname t)) + (cond ((not (file-directory-p newname)) + ;; If NEWNAME is not an existing directory, create it; + ;; that is where we will copy the files of DIRECTORY. + (make-directory newname parents)) + ;; If NEWNAME is an existing directory and COPY-CONTENTS + ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. + ((not copy-contents) + (setq newname (expand-file-name + (file-name-nondirectory + (directory-file-name directory)) + newname)) + (and (file-exists-p newname) + (not (file-directory-p newname)) + (error "Cannot overwrite non-directory %s with a directory" + newname)) + (make-directory newname t))) ;; Copy recursively. (dolist (file -- cgit v1.2.3 From 20fac86e2e61bf25c1f2c6e6c1cac27b994a5346 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 12 Feb 2011 14:43:04 -0500 Subject: * lisp/files.el (copy-directory): Revert to pre-2011-01-29 version. --- lisp/ChangeLog | 4 ++++ lisp/files.el | 64 ++++++++++++++++++---------------------------------------- 2 files changed, 24 insertions(+), 44 deletions(-) (limited to 'lisp/files.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6f2b228eaf8..b77700491c7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-02-12 Chong Yidong + + * files.el (copy-directory): Revert to pre-2011-01-29 version. + 2011-02-12 Chong Yidong * epg.el (epg-delete-output-file, epg-decrypt-string) diff --git a/lisp/files.el b/lisp/files.el index 7ac88f88851..b026bf3352f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4723,23 +4723,19 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well." directory 'full directory-files-no-dot-files-regexp))) (delete-directory-internal directory))))) -(defun copy-directory (directory newname &optional keep-time - parents copy-as-subdir) +(defun copy-directory (directory newname &optional keep-time parents) "Copy DIRECTORY to NEWNAME. Both args must be strings. This function always sets the file modes of the output files to match the corresponding input file. The third arg KEEP-TIME non-nil means give the output files the same last-modified time as the old ones. (This works on only some systems.) -A prefix arg makes KEEP-TIME non-nil. -Optional arg PARENTS says whether to create parent directories if -they don't exist. When called interactively, PARENTS is t. +A prefix arg makes KEEP-TIME non-nil. -When NEWNAME is an existing directory, copy DIRECTORY into a -subdirectory of NEWNAME if optional arg COPY-AS-SUBDIR is -non-nil, otherwise copy the contents of DIRECTORY into NEWNAME. -When called interactively, copy into a subdirectory by default." +Noninteractively, the last argument PARENTS says whether to +create parent directories if they don't exist. Interactively, +this happens by default." (interactive (let ((dir (read-directory-name "Copy directory: " default-directory default-directory t nil))) @@ -4747,7 +4743,7 @@ When called interactively, copy into a subdirectory by default." (read-file-name (format "Copy directory %s to: " dir) default-directory default-directory nil nil) - current-prefix-arg t t))) + current-prefix-arg t))) ;; If default-directory is a remote directory, make sure we find its ;; copy-directory handler. (let ((handler (or (find-file-name-handler directory 'copy-directory) @@ -4758,42 +4754,22 @@ When called interactively, copy into a subdirectory by default." ;; Compute target name. (setq directory (directory-file-name (expand-file-name directory)) newname (directory-file-name (expand-file-name newname))) - - (unless (file-directory-p directory) - (error "%s is not a directory" directory)) - - (cond - ((not (file-directory-p newname)) - ;; If NEWNAME is not an existing directory, create it; - ;; that is where we will copy the files of DIRECTORY. - (make-directory newname parents)) - (copy-as-subdir - ;; If NEWNAME is an existing directory, and we are copying as - ;; a subdirectory, the target is NEWNAME/[DIRECTORY-BASENAME]. - (setq newname (expand-file-name - (file-name-nondirectory - (directory-file-name directory)) - newname)) - (and (file-exists-p newname) - (not (file-directory-p newname)) - (error "Cannot overwrite non-directory %s with a directory" - newname)) - (make-directory newname t))) + (if (not (file-directory-p newname)) (make-directory newname parents)) ;; Copy recursively. - (dolist (file - ;; We do not want to copy "." and "..". - (directory-files directory 'full - directory-files-no-dot-files-regexp)) - (let ((target (expand-file-name - (file-name-nondirectory file) newname)) - (attrs (file-attributes file))) - (cond ((file-directory-p file) - (copy-directory file target keep-time parents nil)) - ((stringp (car attrs)) ; Symbolic link - (make-symbolic-link (car attrs) target t)) - (t - (copy-file file target t keep-time))))) + (mapc + (lambda (file) + (let ((target (expand-file-name + (file-name-nondirectory file) newname)) + (attrs (file-attributes file))) + (cond ((file-directory-p file) + (copy-directory file target keep-time parents)) + ((stringp (car attrs)) ; Symbolic link + (make-symbolic-link (car attrs) target t)) + (t + (copy-file file target t keep-time))))) + ;; We do not want to copy "." and "..". + (directory-files directory 'full directory-files-no-dot-files-regexp)) ;; Set directory attributes. (set-file-modes newname (file-modes directory)) -- cgit v1.2.3 From 72d6685c11031df64b7b039fa658d2fe7727316d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 17 Feb 2011 21:15:22 -0800 Subject: * lisp/files.el (find-file-literally): Doc fix. --- lisp/ChangeLog | 4 ++++ lisp/files.el | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp/files.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 98a9e06e406..cdf6dbf4944 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-02-18 Glenn Morris + + * files.el (find-file-literally): Doc fix. + 2011-02-17 Glenn Morris * simple.el (rfc822-goto-eoh): Give it a doc-string. diff --git a/lisp/files.el b/lisp/files.el index b026bf3352f..88063aed2b9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2008,7 +2008,8 @@ Don't call it from programs! Use `insert-file-contents-literally' instead. (defvar find-file-literally nil "Non-nil if this buffer was made by `find-file-literally' or equivalent. -This is a permanent local.") +This has the `permanent-local' property, which takes effect if you +make the variable buffer-local.") (put 'find-file-literally 'permanent-local t) (defun find-file-literally (filename) -- cgit v1.2.3 From aa56f3613e788df186bef09e2b5414428140377a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Feb 2011 12:18:16 -0500 Subject: * lisp/files.el (cd): Make completion obey cd-path. * lread.c (Qdir_ok): New constant. (syms_of_lread): Initialize it. (openp): Don't ignore directories if the predicate returns dir-ok. Fixes: debbugs:7924 --- lisp/ChangeLog | 4 ++++ lisp/files.el | 56 +++++++++++++++++++++++++++++++++++--------------------- src/ChangeLog | 6 ++++++ src/lread.c | 17 +++++++++++++---- 4 files changed, 58 insertions(+), 25 deletions(-) (limited to 'lisp/files.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f5d7d63cb6f..f65ec67e7b8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-02-18 Stefan Monnier + + * files.el (cd): Make completion obey cd-path (bug#7924). + 2011-02-18 Glenn Morris * progmodes/prolog.el: Don't require compile when compiling. diff --git a/lisp/files.el b/lisp/files.el index 2d3dbc67d72..fdbfe13b671 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -681,26 +681,37 @@ that list of directories (separated by occurrences of `path-separator') when resolving a relative directory name. The path separator is colon in GNU and GNU-like systems." (interactive - (list (read-directory-name "Change default directory: " - default-directory default-directory - (and (member cd-path '(nil ("./"))) - (null (getenv "CDPATH")))))) - (if (file-name-absolute-p dir) - (cd-absolute (expand-file-name dir)) - (if (null cd-path) - (let ((trypath (parse-colon-path (getenv "CDPATH")))) - (setq cd-path (or trypath (list "./"))))) - (if (not (catch 'found - (mapc - (function (lambda (x) - (let ((f (expand-file-name (concat x dir)))) - (if (file-directory-p f) - (progn - (cd-absolute f) - (throw 'found t)))))) - cd-path) - nil)) - (error "No such directory found via CDPATH environment variable")))) + (list + ;; FIXME: There's a subtle bug in the completion below. Seems linked + ;; to a fundamental difficulty of implementing `predicate' correctly. + ;; The manifestation is that TAB may list non-directories in the case where + ;; those files also correspond to valid directories (if your cd-path is (A/ + ;; B/) and you have A/a a file and B/a a directory, then both `a' and `a/' + ;; will be listed as valid completions). + ;; This is because `a' (listed because of A/a) is indeed a valid choice + ;; (which will lead to the use of B/a). + (minibuffer-with-setup-hook + (lambda () + (setq minibuffer-completion-table + (apply-partially #'locate-file-completion-table + cd-path nil)) + (setq minibuffer-completion-predicate + (lambda (dir) + (locate-file dir cd-path nil + (lambda (f) (and (file-directory-p f) 'dir-ok)))))) + (unless cd-path + (setq cd-path (or (parse-colon-path (getenv "CDPATH")) + (list "./")))) + (read-directory-name "Change default directory: " + default-directory default-directory + t)))) + (unless cd-path + (setq cd-path (or (parse-colon-path (getenv "CDPATH")) + (list "./")))) + (cd-absolute + (or (locate-file dir cd-path nil + (lambda (f) (and (file-directory-p f) 'dir-ok))) + (error "No such directory found via CDPATH environment variable")))) (defun load-file (file) "Load the Lisp file named FILE." @@ -720,9 +731,12 @@ If SUFFIXES is non-nil, it should be a list of suffixes to append to file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\"). Use '(\"/\") to disable PATH search, but still try the suffixes in SUFFIXES. If non-nil, PREDICATE is used instead of `file-readable-p'. + +This function will normally skip directories, so if you want it to find +directories, make sure the PREDICATE function returns `dir-ok' for them. + PREDICATE can also be an integer to pass to the `access' system call, in which case file-name handlers are ignored. This usage is deprecated. - For compatibility, PREDICATE can also be one of the symbols `executable', `readable', `writable', or `exists', or a list of one or more of those symbols." diff --git a/src/ChangeLog b/src/ChangeLog index 72a9287513d..9839c7fcc98 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-02-18 Stefan Monnier + + * lread.c (Qdir_ok): New constant. + (syms_of_lread): Initialize it. + (openp): Don't ignore directories if the predicate returns dir-ok. + 2011-02-18 Eli Zaretskii * xdisp.c (display_line): Fix the change made for bug#7939. diff --git a/src/lread.c b/src/lread.c index 7e410fcc334..855869cd90d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1250,7 +1250,9 @@ If SUFFIXES is non-nil, it should be a list of suffixes to append to file name when searching. If non-nil, PREDICATE is used instead of `file-readable-p'. PREDICATE can also be an integer to pass to the access(2) function, -in which case file-name-handlers are ignored. */) +in which case file-name-handlers are ignored. +This function will normally skip directories, so if you want it to find +directories, make sure the PREDICATE function returns `dir-ok' for them. */) (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) { Lisp_Object file; @@ -1260,6 +1262,7 @@ in which case file-name-handlers are ignored. */) return file; } +static Lisp_Object Qdir_ok; /* Search for a file whose name is STR, looking in directories in the Lisp list PATH, and trying suffixes from SUFFIX. @@ -1377,9 +1380,12 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto if (NILP (predicate)) exists = !NILP (Ffile_readable_p (string)); else - exists = !NILP (call1 (predicate, string)); - if (exists && !NILP (Ffile_directory_p (string))) - exists = 0; + { + Lisp_Object tmp = call1 (predicate, string); + exists = !NILP (tmp) + && (EQ (tmp, Qdir_ok) + || !NILP (Ffile_directory_p (string))); + } if (exists) { @@ -4377,6 +4383,9 @@ to load. See also `load-dangerous-libraries'. */); Qfile_truename = intern_c_string ("file-truename"); staticpro (&Qfile_truename) ; + Qdir_ok = intern_c_string ("dir-ok"); + staticpro (&Qdir_ok); + Qdo_after_load_evaluation = intern_c_string ("do-after-load-evaluation"); staticpro (&Qdo_after_load_evaluation) ; -- cgit v1.2.3