From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Thierry Volpiatto Newsgroups: gmane.emacs.bugs Subject: bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy Date: Fri, 24 Feb 2012 06:37:26 +0100 Message-ID: <87zkc8x04p.fsf@gmail.com> References: <87mx9su32g.fsf@web.de> <87vcodm8ns.fsf@gmx.de> <87pqekopb5.fsf@gmail.com> <87hazwoost.fsf@gmail.com> <87ty3w9639.fsf@gmx.de> <8762gckckt.fsf@gmail.com> <87pqek9269.fsf@gmx.de> <87r4z0yqfx.fsf@gmail.com> <871uqzn3bc.fsf@gmx.de> <871uqz651u.fsf@gmx.de> <87pqd89lh4.fsf@gmail.com> <87mx8b3nvb.fsf@gmail.com> <87pqd6wnvv.fsf@gmail.com> <87d395y1w0.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1330061957 21137 80.91.229.3 (24 Feb 2012 05:39:17 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Fri, 24 Feb 2012 05:39:17 +0000 (UTC) Cc: 10489@debbugs.gnu.org, Michael Albinus To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Feb 24 06:39:15 2012 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from [140.186.70.17] (helo=lists.gnu.org) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1S0ns9-0006gN-RN for geb-bug-gnu-emacs@m.gmane.org; Fri, 24 Feb 2012 06:39:14 +0100 Original-Received: from localhost ([::1]:35540 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0nrp-0007AQ-9w for geb-bug-gnu-emacs@m.gmane.org; Fri, 24 Feb 2012 00:38:53 -0500 Original-Received: from eggs.gnu.org ([140.186.70.92]:48361) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0nrj-0007A3-RP for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 00:38:50 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1S0nrZ-0004aE-N8 for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 00:38:40 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:49613) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0nrZ-0004Zw-Iz for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 00:38:37 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1S0ntu-0003Xw-1J for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 00:41:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Thierry Volpiatto Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 24 Feb 2012 05:41:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 10489 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 10489-submit@debbugs.gnu.org id=B10489.133006201913543 (code B ref 10489); Fri, 24 Feb 2012 05:41:01 +0000 Original-Received: (at 10489) by debbugs.gnu.org; 24 Feb 2012 05:40:19 +0000 Original-Received: from localhost ([127.0.0.1]:53236 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S0nt8-0003WB-I7 for submit@debbugs.gnu.org; Fri, 24 Feb 2012 00:40:16 -0500 Original-Received: from mail-wi0-f172.google.com ([209.85.212.172]:51283) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S0nt2-0003Vl-DT for 10489@debbugs.gnu.org; Fri, 24 Feb 2012 00:40:12 -0500 Original-Received: by wibhm9 with SMTP id hm9so1203811wib.3 for <10489@debbugs.gnu.org>; Thu, 23 Feb 2012 21:37:30 -0800 (PST) Received-SPF: pass (google.com: domain of thierry.volpiatto@gmail.com designates 10.180.78.130 as permitted sender) client-ip=10.180.78.130; Authentication-Results: mr.google.com; spf=pass (google.com: domain of thierry.volpiatto@gmail.com designates 10.180.78.130 as permitted sender) smtp.mail=thierry.volpiatto@gmail.com; dkim=pass header.i=thierry.volpiatto@gmail.com Original-Received: from mr.google.com ([10.180.78.130]) by 10.180.78.130 with SMTP id b2mr1813469wix.1.1330061850892 (num_hops = 1); Thu, 23 Feb 2012 21:37:30 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version:content-type; bh=3k9R9LJuiYzWlPbTlRKzHaWblYdYOILTjUmFZDovJgE=; b=R6ORJQdRAT+ntnsfBIiVOq5tj6prf7nGBFbO5b+7cgGWALBjz8/HhSq5n3sviVKU1O NxglgKtFgO/JlmS34qg47R/Djnzbu+nYjCf1EWlyTuq0hEHm6YKX8+dw8MMnf/RUjGXk R6J7SzhfdBs5oi7H5/Yg4OZz/aZ0QIPwRCZts= Original-Received: by 10.180.78.130 with SMTP id b2mr1488454wix.1.1330061850787; Thu, 23 Feb 2012 21:37:30 -0800 (PST) Original-Received: from thierry-MM061 (lbe83-2-78-243-104-167.fbx.proxad.net. [78.243.104.167]) by mx.google.com with ESMTPS id h19sm1090881wiw.9.2012.02.23.21.37.28 (version=TLSv1/SSLv3 cipher=OTHER); Thu, 23 Feb 2012 21:37:29 -0800 (PST) In-Reply-To: (Stefan Monnier's message of "Thu, 23 Feb 2012 12:18:51 -0500") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.93 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:57157 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Stefan Monnier writes: > I think we can install the file-subdir-of-p test now and leave the rest > for 24.2. Can you (re)send the corresponding patch? Note that > (or (files-equal-p directory newname) > (file-subdir-of-p newname directory)) > should be replaced by just (file-subdir-of-p newname directory), because > this primitive should be a "=E2=8A=86" rather than "=E2=8A=82". I have removed one more occurence of `files-equal-p' no more needed in dired-aux.el. So this function is not needed actually; I have not removed it though. Maybe I should and add it only after 24.1? --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=patch-r118916.patch Content-Description: dired-create-files modif # HG changeset patch # User Thierry Volpiatto # Date 1330061336 -3600 # Node ID b41b1ec2b6dbe7fa96efa4b1a0dcb3be8133a46c # Parent c136fe29a3a316a56bae9c9d8dec2d8add468d48 Fix bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy. * lisp/files.el (files-equal-p): New, simple equality check between two filename. (file-subdir-of-p): New, Check if file1 is subdir of file2. (copy-directory): Return error when trying to copy a directory on itself. * lisp/dired-aux.el (dired-copy-file-recursive): Same. (dired-create-files): Modify destination when source is equal to dest when copying files. Return also when dest is a subdir of source. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1264,24 +1264,26 @@ (defun dired-copy-file-recursive (from to ok-flag &optional preserve-time top recursive) + (when (file-subdir-of-p to from) + (error "Can't copy directory `%s' on itself" from)) (let ((attrs (file-attributes from))) (if (and recursive - (eq t (car attrs)) - (or (eq recursive 'always) - (yes-or-no-p (format "Recursive copies of %s? " from)))) - ;; This is a directory. - (copy-directory from to preserve-time) + (eq t (car attrs)) + (or (eq recursive 'always) + (yes-or-no-p (format "Recursive copies of %s? " from)))) + ;; This is a directory. + (copy-directory from to preserve-time) ;; Not a directory. (or top (dired-handle-overwrite to)) (condition-case err - (if (stringp (car attrs)) - ;; It is a symlink - (make-symbolic-link (car attrs) to ok-flag) - (copy-file from to ok-flag preserve-time)) - (file-date-error - (push (dired-make-relative from) - dired-create-files-failures) - (dired-log "Can't set date on %s:\n%s\n" from err)))))) + (if (stringp (car attrs)) + ;; It is a symlink + (make-symbolic-link (car attrs) to ok-flag) + (copy-file from to ok-flag preserve-time)) + (file-date-error + (push (dired-make-relative from) + dired-create-files-failures) + (dired-log "Can't set date on %s:\n%s\n" from err)))))) ;;;###autoload (defun dired-rename-file (file newname ok-if-already-exists) @@ -1378,7 +1380,7 @@ ;; The basic function for half a dozen variations on cp/mv/ln/ln -s. (defun dired-create-files (file-creator operation fn-list name-constructor - &optional marker-char) + &optional marker-char) "Create one or more new files from a list of existing files FN-LIST. This function also handles querying the user, updating Dired buffers, and displaying a success or failure message. @@ -1401,10 +1403,14 @@ Optional MARKER-CHAR is a character with which to mark every newfile's entry, or t to use the current marker character if the old file was marked." - (let (dired-create-files-failures failures - skipped (success-count 0) (total (length fn-list))) - (let (to overwrite-query - overwrite-backup-query) ; for dired-handle-overwrite + (let (dired-create-files-failures + failures + skipped + (success-count 0) + (total (length fn-list))) + (let (to + overwrite-query + overwrite-backup-query) ; for dired-handle-overwrite (dolist (from fn-list) (setq to (funcall name-constructor from)) (if (equal to from) @@ -1430,10 +1436,26 @@ (cond ((integerp marker-char) marker-char) (marker-char (dired-file-marker from)) ; slow (t nil)))) - (when (and (file-directory-p from) - (file-directory-p to) - (eq file-creator 'dired-copy-file)) - (setq to (file-name-directory to))) + ;; Handle the `dired-copy-file' file-creator specially + ;; When copying a directory to another directory or + ;; possibly to itself. + ;; (e.g "~/foo" => "~/test" or "~/foo" =>"~/foo") + ;; In this case the 'name-constructor' have set the destination + ;; 'to' to "~/test/foo" because the old + ;; emacs23 behavior of `copy-directory' + ;; was no not create the subdir and copy instead the contents only. + ;; With it's new behavior (similar to cp shell command) we don't + ;; need such a construction, so modify the destination 'to' to + ;; "~/test/" instead of "~/test/foo/". + ;; If from and to are the same directory do the same, + ;; the error will be handled by `dired-copy-file-recursive'. + (let ((destname (file-name-directory to))) + (when (and (file-directory-p from) + (file-directory-p to) + (eq file-creator 'dired-copy-file)) + (setq to destname)) + (and (file-subdir-of-p destname from) + (error "Can't copy directory `%s' on itself" from))) (condition-case err (progn (funcall file-creator from to dired-overwrite-confirmed) @@ -1456,25 +1478,25 @@ (setq failures (nconc failures dired-create-files-failures)) (dired-log-summary (format "%s failed for %d file%s in %d requests" - operation (length failures) - (dired-plural-s (length failures)) - total) + operation (length failures) + (dired-plural-s (length failures)) + total) failures)) (failures (dired-log-summary (format "%s failed for %d of %d file%s" - operation (length failures) - total (dired-plural-s total)) + operation (length failures) + total (dired-plural-s total)) failures)) (skipped (dired-log-summary (format "%s: %d of %d file%s skipped" - operation (length skipped) total - (dired-plural-s total)) + operation (length skipped) total + (dired-plural-s total)) skipped)) (t (message "%s: %s file%s" - operation success-count (dired-plural-s success-count))))) + operation success-count (dired-plural-s success-count))))) (dired-move-to-filename)) (defun dired-do-create-files (op-symbol file-creator operation arg diff --git a/lisp/files.el b/lisp/files.el --- a/lisp/files.el +++ b/lisp/files.el @@ -510,36 +510,14 @@ (other :tag "Query" other)) :group 'find-file) -;; This is an odd variable IMO. -;; You might wonder why it is needed, when we could just do: -;; (set (make-local-variable 'enable-local-variables) nil) -;; These two are not precisely the same. -;; Setting this variable does not cause -*- mode settings to be -;; ignored, whereas setting enable-local-variables does. -;; Only three places in Emacs use this variable: tar and arc modes, -;; and rmail. The first two don't need it. They already use -;; inhibit-local-variables-regexps, which is probably enough, and -;; could also just set enable-local-variables locally to nil. -;; Them setting it has the side-effect that dir-locals cannot apply to -;; eg tar files (?). FIXME Is this appropriate? -;; AFAICS, rmail is the only thing that needs this, and the only -;; reason it uses it is for BABYL files (which are obsolete). -;; These contain "-*- rmail -*-" in the first line, which rmail wants -;; to respect, so that find-file on a BABYL file will switch to -;; rmail-mode automatically (this is nice, but hardly essential, -;; since most people are used to explicitly running a command to -;; access their mail; M-x gnus etc). Rmail files may happen to -;; contain Local Variables sections in messages, which Rmail wants to -;; ignore. So AFAICS the only reason this variable exists is for a -;; minor convenience feature for handling of an obsolete Rmail file format. (defvar local-enable-local-variables t "Like `enable-local-variables' but meant for buffer-local bindings. The meaningful values are nil and non-nil. The default is non-nil. If a major mode sets this to nil, buffer-locally, then any local -variables list in a file visited in that mode will be ignored. - -This variable does not affect the use of major modes specified -in a -*- line.") +variables list in the file will be ignored. + +This variable does not affect the use of major modes +specified in a -*- line.") (defcustom enable-local-eval 'maybe "Control processing of the \"variable\" `eval' in a file's local variables. @@ -981,18 +959,20 @@ (defcustom remote-file-name-inhibit-cache 10 "Whether to use the remote file-name cache for read access. -When `nil', never expire cached values (caution) -When `t', never use the cache (safe, but may be slow) -A number means use cached values for that amount of seconds since caching. - -The attributes of remote files are cached for better performance. -If they are changed outside of Emacs's control, the cached values -become invalid, and must be reread. If you are sure that nothing -other than Emacs changes the files, you can set this variable to `nil'. - -If a remote file is checked regularly, it might be a good idea to -let-bind this variable to a value less than the interval between -consecutive checks. For example: + +When `nil', always use the cached values. +When `t', never use them. +A number means use them for that amount of seconds since they were +cached. + +File attributes of remote files are cached for better performance. +If they are changed out of Emacs' control, the cached values +become invalid, and must be invalidated. + +In case a remote file is checked regularly, it might be +reasonable to let-bind this variable to a value less then the +time period between two checks. +Example: (defun display-time-file-nonempty-p (file) (let ((remote-file-name-inhibit-cache (- display-time-interval 5))) @@ -2425,6 +2405,9 @@ calling FUNCTION (if it's not nil), we delete the suffix that matched REGEXP and search the list again for another match. +If the file name matches `inhibit-first-line-modes-regexps', +then `auto-mode-alist' is not processed. + The extensions whose FUNCTION is `archive-mode' should also appear in `auto-coding-alist' with `no-conversion' coding system. @@ -2495,55 +2478,16 @@ See also `auto-mode-alist'.") -(define-obsolete-variable-alias 'inhibit-first-line-modes-regexps - 'inhibit-file-local-variables-regexps "24.1") - -;; TODO really this should be a list of modes (eg tar-mode), not regexps, -;; because we are duplicating info from auto-mode-alist. -;; TODO many elements of this list are also in auto-coding-alist. -(defvar inhibit-local-variables-regexps - (mapcar 'purecopy '("\\.tar\\'" "\\.t[bg]z\\'" - "\\.arc\\'" "\\.zip\\'" "\\.lzh\\'" "\\.lha\\'" - "\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'" - "\\.7z\\'" - "\\.sx[dmicw]\\'" "\\.odt\\'" - "\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'")) - "List of regexps matching file names in which to ignore local variables. -This includes `-*-' lines as well as trailing \"Local Variables\" sections. -Files matching this list are typically binary file formats. -They may happen to contain sequences that look like local variable -specifications, but are not really, or they may be containers for -member files with their own local variable sections, which are -not appropriate for the containing file. -See also `inhibit-local-variables-suffixes'.") - -(define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes - 'inhibit-local-variables-suffixes "24.1") - -(defvar inhibit-local-variables-suffixes nil - "List of regexps matching suffixes to remove from file names. -When checking `inhibit-local-variables-regexps', we first discard +(defvar inhibit-first-line-modes-regexps + (mapcar 'purecopy '("\\.tar\\'" "\\.tgz\\'" "\\.tiff?\\'" + "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'")) + "List of regexps; if one matches a file name, don't look for `-*-'.") + +(defvar inhibit-first-line-modes-suffixes nil + "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'. +When checking `inhibit-first-line-modes-regexps', we first discard from the end of the file name anything that matches one of these regexps.") -;; TODO explicitly add case-fold-search t? -(defun inhibit-local-variables-p () - "Return non-nil if file local variables should be ignored. -This checks the file (or buffer) name against `inhibit-local-variables-regexps' -and `inhibit-local-variables-suffixes'." - (let ((temp inhibit-local-variables-regexps) - (name (if buffer-file-name - (file-name-sans-versions buffer-file-name) - (buffer-name)))) - (while (let ((sufs inhibit-local-variables-suffixes)) - (while (and sufs (not (string-match (car sufs) name))) - (setq sufs (cdr sufs))) - sufs) - (setq name (substring name 0 (match-beginning 0)))) - (while (and temp - (not (string-match (car temp) name))) - (setq temp (cdr temp))) - temp)) - (defvar auto-mode-interpreter-regexp (purecopy "#![ \t]?\\([^ \t\n]*\ /bin/env[ \t]\\)?\\([^ \t\n]+\\)") @@ -2606,24 +2550,21 @@ (defun set-auto-mode (&optional keep-mode-if-same) "Select major mode appropriate for current buffer. -To find the right major mode, this function checks for a -*- mode tag +To find the right major mode, this function checks for a -*- mode tag, checks for a `mode:' entry in the Local Variables section of the file, checks if it uses an interpreter listed in `interpreter-mode-alist', matches the buffer beginning against `magic-mode-alist', compares the filename against the entries in `auto-mode-alist', then matches the buffer beginning against `magic-fallback-mode-alist'. -If `enable-local-variables' is nil, or if the file name matches -`inhibit-local-variables-regexps', this function does not check -for any mode: tag anywhere in the file. If `local-enable-local-variables' -is nil, then the only mode: tag that can be relevant is a -*- one. +If `enable-local-variables' is nil, this function does not check for +any mode: tag anywhere in the file. If the optional argument KEEP-MODE-IF-SAME is non-nil, then we set the major mode only if that would change it. In other words we don't actually set it to the same mode the buffer already has." ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- - (let ((try-locals (not (inhibit-local-variables-p))) - end done mode modes) + (let (end done mode modes) ;; Once we drop the deprecated feature where mode: is also allowed to ;; specify minor-modes (ie, there can be more than one "mode:"), we can ;; remove this section and just let (hack-local-variables t) handle it. @@ -2631,9 +2572,7 @@ (save-excursion (goto-char (point-min)) (skip-chars-forward " \t\n") - ;; Note by design local-enable-local-variables does not matter here. (and enable-local-variables - try-locals (setq end (set-auto-mode-1)) (if (save-excursion (search-forward ":" end t)) ;; Find all specifications for the `mode:' variable @@ -2664,12 +2603,8 @@ (or (set-auto-mode-0 mode keep-mode-if-same) ;; continuing would call minor modes again, toggling them off (throw 'nop nil)))))) - ;; hack-local-variables checks local-enable-local-variables etc, but - ;; we might as well be explicit here for the sake of clarity. (and (not done) enable-local-variables - local-enable-local-variables - try-locals (setq mode (hack-local-variables t)) (not (memq mode modes)) ; already tried and failed (if (not (functionp mode)) @@ -2779,24 +2714,38 @@ (defun set-auto-mode-1 () "Find the -*- spec in the buffer. Call with point at the place to start searching from. -If one is found, set point to the beginning and return the position -of the end. Otherwise, return nil; may change point. -The variable `inhibit-local-variables-regexps' can cause a -*- spec to -be ignored; but `enable-local-variables' and `local-enable-local-variables' -have no effect." +If one is found, set point to the beginning +and return the position of the end. +Otherwise, return nil; point may be changed." (let (beg end) (and ;; Don't look for -*- if this file name matches any - ;; of the regexps in inhibit-local-variables-regexps. - (not (inhibit-local-variables-p)) + ;; of the regexps in inhibit-first-line-modes-regexps. + (let ((temp inhibit-first-line-modes-regexps) + (name (if buffer-file-name + (file-name-sans-versions buffer-file-name) + (buffer-name)))) + (while (let ((sufs inhibit-first-line-modes-suffixes)) + (while (and sufs (not (string-match (car sufs) name))) + (setq sufs (cdr sufs))) + sufs) + (setq name (substring name 0 (match-beginning 0)))) + (while (and temp + (not (string-match (car temp) name))) + (setq temp (cdr temp))) + (not temp)) + (search-forward "-*-" (line-end-position - ;; If the file begins with "#!" (exec - ;; interpreter magic), look for mode frobs - ;; in the first two lines. You cannot - ;; necessarily put them in the first line - ;; of such a file without screwing up the - ;; interpreter invocation. The same holds - ;; for '\" in man pages (preprocessor + ;; If the file begins with "#!" + ;; (exec interpreter magic), look + ;; for mode frobs in the first two + ;; lines. You cannot necessarily + ;; put them in the first line of + ;; such a file without screwing up + ;; the interpreter invocation. + ;; The same holds for + ;; '\" + ;; in man pages (preprocessor ;; magic for the `man' program). (and (looking-at "^\\(#!\\|'\\\\\"\\)") 2)) t) (progn @@ -3141,41 +3090,19 @@ If MODE-ONLY is non-nil, all we do is check whether a \"mode:\" is specified, and return the corresponding mode symbol, or nil. In this case, we try to ignore minor-modes, and only return a -major-mode. - -If `enable-local-variables' or `local-enable-local-variables' is nil, -this function does nothing. If `inhibit-local-variables-regexps' -applies to the file in question, the file is not scanned for -local variables, but directory-local variables may still be applied." - ;; We don't let inhibit-local-variables-p influence the value of - ;; enable-local-variables, because then it would affect dir-local - ;; variables. We don't want to search eg tar files for file local - ;; variable sections, but there is no reason dir-locals cannot apply - ;; to them. The real meaning of inhibit-local-variables-p is "do - ;; not scan this file for local variables". +major-mode." (let ((enable-local-variables (and local-enable-local-variables enable-local-variables)) result) (unless mode-only (setq file-local-variables-alist nil) (report-errors "Directory-local variables error: %s" - ;; Note this is a no-op if enable-local-variables is nil. (hack-dir-local-variables))) - ;; This entire function is basically a no-op if enable-local-variables - ;; is nil. All it does is set file-local-variables-alist to nil. - (when enable-local-variables - ;; This part used to ignore enable-local-variables when mode-only - ;; was non-nil. That was inappropriate, eg consider the - ;; (artificial) example of: - ;; (setq local-enable-local-variables nil) - ;; Open a file foo.txt that contains "mode: sh". - ;; It correctly opens in text-mode. - ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode. - (unless (or (inhibit-local-variables-p) - ;; If MODE-ONLY is non-nil, and the prop line specifies a - ;; mode, then we're done, and have no need to scan further. - (and (setq result (hack-local-variables-prop-line mode-only)) - mode-only)) + (when (or mode-only enable-local-variables) + ;; If MODE-ONLY is non-nil, and the prop line specifies a mode, + ;; then we're done, and have no need to scan further. + (unless (and (setq result (hack-local-variables-prop-line mode-only)) + mode-only) ;; Look for "Local variables:" line in last page. (save-excursion (goto-char (point-max)) @@ -3265,13 +3192,14 @@ (indirect-variable var)) val) result) (error nil))))) - (forward-line 1)))))))) - ;; Now we've read all the local variables. - ;; If MODE-ONLY is non-nil, return whether the mode was specified. - (if mode-only result - ;; Otherwise, set the variables. - (hack-local-variables-filter result nil) - (hack-local-variables-apply))))) + (forward-line 1))))))))) + ;; Now we've read all the local variables. + ;; If MODE-ONLY is non-nil, return whether the mode was specified. + (cond (mode-only result) + ;; Otherwise, set the variables. + (enable-local-variables + (hack-local-variables-filter result nil) + (hack-local-variables-apply))))) (defun hack-local-variables-apply () "Apply the elements of `file-local-variables-alist'. @@ -3683,7 +3611,7 @@ (interactive "FSet visited file name: ") (if (buffer-base-buffer) (error "An indirect buffer cannot visit a file")) - (let (truename old-try-locals) + (let (truename) (if filename (setq filename (if (string-equal filename "") @@ -3708,8 +3636,7 @@ (progn (and filename (lock-buffer filename)) (unlock-buffer))) - (setq old-try-locals (not (inhibit-local-variables-p)) - buffer-file-name filename) + (setq buffer-file-name filename) (if filename ; make buffer name reflect filename. (let ((new-name (file-name-nondirectory buffer-file-name))) (setq default-directory (file-name-directory buffer-file-name)) @@ -4861,13 +4788,7 @@ (defun rename-uniquely () "Rename current buffer to a similar name not already taken. This function is useful for creating multiple shell process buffers -or multiple mail buffers, etc. - -Note that some commands, in particular those based on `compilation-mode' -\(`compile', `grep', etc.) will reuse the current buffer if it has the -appropriate mode even if it has been renamed. So as well as renaming -the buffer, you also need to switch buffers before running another -instance of such commands." +or multiple mail buffers, etc." (interactive) (save-match-data (let ((base-name (buffer-name))) @@ -4985,6 +4906,35 @@ directory 'full directory-files-no-dot-files-regexp))) (delete-directory-internal directory))))) +(defun files-equal-p (file1 file2) + "Return non-nil if FILE1 and FILE2 name the same file." + (and (equal (file-remote-p file1) (file-remote-p file2)) + (equal (file-attributes (file-truename (expand-file-name file1))) + (file-attributes (file-truename (expand-file-name file2)))))) + +(defun file-subdir-of-p (file1 file2) + "Check if FILE1 is a subdirectory of FILE2 on current filesystem. +If directory FILE1 is the same than directory FILE2, return non--nil." + (when (and (not (or (file-remote-p file1) + (file-remote-p file2))) + (not (string= file1 "/")) + (file-directory-p file1) + (file-directory-p file2)) + (or (string= file2 "/") + (loop with f1 = (expand-file-name (file-truename file1)) + with f2 = (expand-file-name (file-truename file2)) + with ls1 = (split-string f1 "/" t) + with ls2 = (split-string f2 "/" t) + for p = (string-match "^/" f1) + for i in ls1 + for j in ls2 + when (string= i j) + concat (if p (concat "/" i) (concat i "/")) + into root + finally return + (equal (file-attributes (file-truename root)) + (file-attributes f2)))))) + (defun copy-directory (directory newname &optional keep-time parents copy-contents) "Copy DIRECTORY to NEWNAME. Both args must be strings. This function always sets the file modes of the output files to match @@ -5011,10 +4961,12 @@ (format "Copy directory %s to: " dir) default-directory default-directory nil nil) current-prefix-arg t nil))) + (when (file-subdir-of-p newname directory) + (error "Can't copy directory `%s' on itself" directory)) ;; 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) - (find-file-name-handler newname 'copy-directory)))) + (find-file-name-handler newname 'copy-directory)))) (if handler (funcall handler 'copy-directory directory newname keep-time parents) @@ -5048,7 +5000,7 @@ (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 + (if (stringp (car attrs)) ; Symbolic link (make-symbolic-link (car attrs) target t) (copy-file file target t keep-time))))) @@ -5135,8 +5087,6 @@ Optional third argument PRESERVE-MODES non-nil means don't alter the files modes. Normally we reinitialize them using `normal-mode'. -This function binds `revert-buffer-in-progress-p' non-nil while it operates. - If the value of `revert-buffer-function' is non-nil, it is called to do all the work for this command. Otherwise, the hooks `before-revert-hook' and `after-revert-hook' are run at the beginning --=-=-= Content-Type: text/plain -- Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997 --=-=-=--