/[emacs]/emacs/lisp/files.el
ViewVC logotype

Diff of /emacs/lisp/files.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.666.2.2 by handa, Fri Apr 16 12:49:50 2004 UTC revision 1.666.2.3 by miles, Mon Jun 28 07:28:39 2004 UTC
# Line 293  Normally auto-save files are written und Line 293  Normally auto-save files are written und
293    :group 'auto-save)    :group 'auto-save)
294    
295  (defcustom auto-save-file-name-transforms  (defcustom auto-save-file-name-transforms
296    `(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)"    `(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
297       ;; Don't put "\\2" inside expand-file-name, since it will be       ;; Don't put "\\2" inside expand-file-name, since it will be
298       ;; transformed to "/2" on DOS/Windows.       ;; transformed to "/2" on DOS/Windows.
299       ,(concat temporary-file-directory "\\2") t))       ,(concat temporary-file-directory "\\2") t))
# Line 481  Runs the usual ange-ftp hook, but only f Line 481  Runs the usual ange-ftp hook, but only f
481    
482  (defun convert-standard-filename (filename)  (defun convert-standard-filename (filename)
483    "Convert a standard file's name to something suitable for the current OS.    "Convert a standard file's name to something suitable for the current OS.
484  This function's standard definition is trivial; it just returns the argument.  This means to guarantee valid names and perhaps to canonicalize
485  However, on some systems, the function is redefined with a definition  certain patterns.
486  that really does change some file names to canonicalize certain  
487  patterns and to guarantee valid names."  This function's standard definition is trivial; it just returns
488    the argument.  However, on Windows and DOS, replace invalid
489    characters.  On DOS, make sure to obey the 8.3 limitations.  On
490    Windows, turn Cygwin names into native names, and also turn
491    slashes into backslashes if the shell requires it (see
492    `w32-shell-dos-semantics')."
493    filename)    filename)
494    
495  (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)  (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
# Line 521  the value of `default-directory'." Line 526  the value of `default-directory'."
526  Not actually set up until the first time you use it.")  Not actually set up until the first time you use it.")
527    
528  (defun parse-colon-path (cd-path)  (defun parse-colon-path (cd-path)
529    "Explode a colon-separated search path into a list of directory names.    "Explode a search path into a list of directory names.
530  \(For values of `colon' equal to `path-separator'.)"  Directories are separated by occurrences of `path-separator'
531    \(which is colon in GNU and GNU-like systems)."
532    ;; We could use split-string here.    ;; We could use split-string here.
533    (and cd-path    (and cd-path
534         (let (cd-list (cd-start 0) cd-colon)         (let (cd-list (cd-start 0) cd-colon)
# Line 555  Not actually set up until the first time Line 561  Not actually set up until the first time
561    
562  (defun cd (dir)  (defun cd (dir)
563    "Make DIR become the current buffer's default directory.    "Make DIR become the current buffer's default directory.
564  If your environment includes a `CDPATH' variable, try each one of that  If your environment includes a `CDPATH' variable, try each one of
565  colon-separated list of directories when resolving a relative directory name."  that list of directories (separated by occurrences of
566    `path-separator') when resolving a relative directory name.
567    The path separator is colon in GNU and GNU-like systems."
568    (interactive    (interactive
569     (list (read-directory-name "Change default directory: "     (list (read-directory-name "Change default directory: "
570                           default-directory default-directory                           default-directory default-directory
# Line 616  PATH-AND-SUFFIXES is a pair of lists (DI Line 624  PATH-AND-SUFFIXES is a pair of lists (DI
624            (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))            (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))
625            (string-dir (file-name-directory string)))            (string-dir (file-name-directory string)))
626        (dolist (dir (car path-and-suffixes))        (dolist (dir (car path-and-suffixes))
627            (unless dir
628              (setq dir default-directory))
629          (if string-dir (setq dir (expand-file-name string-dir dir)))          (if string-dir (setq dir (expand-file-name string-dir dir)))
630          (when (file-directory-p dir)          (when (file-directory-p dir)
631            (dolist (file (file-name-all-completions            (dolist (file (file-name-all-completions
# Line 640  This is an interface to the function `lo Line 650  This is an interface to the function `lo
650    
651  (defun file-remote-p (file)  (defun file-remote-p (file)
652    "Test whether FILE specifies a location on a remote system."    "Test whether FILE specifies a location on a remote system."
653    (let ((handler (find-file-name-handler file 'file-local-copy)))    (let ((handler (find-file-name-handler file 'file-remote-p)))
654      (if handler      (if handler
655          (get handler 'file-remote-p))))          (funcall handler 'file-remote-p file)
656          nil)))
657    
658  (defun file-local-copy (file)  (defun file-local-copy (file)
659    "Copy the file FILE into a temporary file on this machine.    "Copy the file FILE into a temporary file on this machine.
# Line 661  The truename of a file name is found by Line 672  The truename of a file name is found by
672  both at the level of the file and at the level of the directories  both at the level of the file and at the level of the directories
673  containing it, until no links are left at any level.  containing it, until no links are left at any level.
674    
675  The arguments COUNTER and PREV-DIRS are used only in recursive calls.  \(fn FILENAME)"
676  Do not specify them in other calls."    ;; COUNTER and PREV-DIRS are only used in recursive calls.
677    ;; COUNTER can be a cons cell whose car is the count of how many more links    ;; COUNTER can be a cons cell whose car is the count of how many
678    ;; to chase before getting an error.    ;; more links to chase before getting an error.
679    ;; PREV-DIRS can be a cons cell whose car is an alist    ;; PREV-DIRS can be a cons cell whose car is an alist
680    ;; of truenames we've just recently computed.    ;; of truenames we've just recently computed.
681      (cond ((or (string= filename "") (string= filename "~"))
682             (setq filename (expand-file-name filename))
683             (if (string= filename "")
684                 (setq filename "/")))
685            ((and (string= (substring filename 0 1) "~")
686                  (string-match "~[^/]*/?" filename))
687             (let ((first-part
688                    (substring filename 0 (match-end 0)))
689                   (rest (substring filename (match-end 0))))
690               (setq filename (concat (expand-file-name first-part) rest)))))
691    
   ;; The last test looks dubious, maybe `+' is meant here?  --simon.  
   (if (or (string= filename "") (string= filename "~")  
           (and (string= (substring filename 0 1) "~")  
                (string-match "~[^/]*" filename)))  
       (progn  
         (setq filename (expand-file-name filename))  
         (if (string= filename "")  
             (setq filename "/"))))  
692    (or counter (setq counter (list 100)))    (or counter (setq counter (list 100)))
693    (let (done    (let (done
694          ;; For speed, remove the ange-ftp completion handler from the list.          ;; For speed, remove the ange-ftp completion handler from the list.
# Line 901  but the visited file name is available t Line 914  but the visited file name is available t
914  type M-n to pull it into the minibuffer.  type M-n to pull it into the minibuffer.
915    
916  Interactively, or if WILDCARDS is non-nil in a call from Lisp,  Interactively, or if WILDCARDS is non-nil in a call from Lisp,
917  expand wildcards (if any) and visit multiple files.  Wildcard expansion  expand wildcards (if any) and visit multiple files.  You can
918  can be suppressed by setting `find-file-wildcards'."  suppress wildcard expansion by setting `find-file-wildcards'.
919    
920    To visit a file without any kind of conversion and without
921    automatically choosing a major mode, use \\[find-file-literally]."
922    (interactive    (interactive
923     (find-file-read-args "Find file: " nil))     (find-file-read-args "Find file: " nil))
924    (let ((value (find-file-noselect filename nil nil wildcards)))    (let ((value (find-file-noselect filename nil nil wildcards)))
# Line 1353  that are visiting the various files." Line 1369  that are visiting the various files."
1369                                  rawfile truename number))))))                                  rawfile truename number))))))
1370    
1371  (defun find-file-noselect-1 (buf filename nowarn rawfile truename number)  (defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
1372    (let ((inhibit-read-only t)    (let (error)
         error)  
1373      (with-current-buffer buf      (with-current-buffer buf
1374        (kill-local-variable 'find-file-literally)        (kill-local-variable 'find-file-literally)
1375        ;; Needed in case we are re-visiting the file with a different        ;; Needed in case we are re-visiting the file with a different
1376        ;; text representation.        ;; text representation.
1377        (kill-local-variable 'buffer-file-coding-system)        (kill-local-variable 'buffer-file-coding-system)
1378        (kill-local-variable 'cursor-type)        (kill-local-variable 'cursor-type)
1379        (erase-buffer)        (let ((inhibit-read-only t))
1380            (erase-buffer))
1381        (and (default-value 'enable-multibyte-characters)        (and (default-value 'enable-multibyte-characters)
1382             (not rawfile)             (not rawfile)
1383             (set-buffer-multibyte t))             (set-buffer-multibyte t))
1384        (if rawfile        (if rawfile
1385            (condition-case ()            (condition-case ()
1386                (insert-file-contents-literally filename t)                (let ((inhibit-read-only t))
1387                    (insert-file-contents-literally filename t))
1388              (file-error              (file-error
1389               (when (and (file-exists-p filename)               (when (and (file-exists-p filename)
1390                          (not (file-readable-p filename)))                          (not (file-readable-p filename)))
# Line 1377  that are visiting the various files." Line 1394  that are visiting the various files."
1394               ;; Unconditionally set error               ;; Unconditionally set error
1395               (setq error t)))               (setq error t)))
1396          (condition-case ()          (condition-case ()
1397              (insert-file-contents filename t)              (let ((inhibit-read-only t))
1398                  (insert-file-contents filename t))
1399            (file-error            (file-error
1400             (when (and (file-exists-p filename)             (when (and (file-exists-p filename)
1401                        (not (file-readable-p filename)))                        (not (file-readable-p filename)))
# Line 2325  However, the mode will not be changed if Line 2343  However, the mode will not be changed if
2343  (defun set-visited-file-name (filename &optional no-query along-with-file)  (defun set-visited-file-name (filename &optional no-query along-with-file)
2344    "Change name of file visited in current buffer to FILENAME.    "Change name of file visited in current buffer to FILENAME.
2345  The next time the buffer is saved it will go in the newly specified file.  The next time the buffer is saved it will go in the newly specified file.
2346  nil or empty string as argument means make buffer not be visiting any file.  FILENAME nil or an empty string means make buffer not be visiting any file.
2347  Remember to delete the initial contents of the minibuffer  Remember to delete the initial contents of the minibuffer
2348  if you wish to pass an empty string as the argument.  if you wish to pass an empty string as the argument.
2349    
# Line 2897  on a DOS/Windows machine, it returns FIL Line 2915  on a DOS/Windows machine, it returns FIL
2915            (file-name-as-directory (expand-file-name (or directory            (file-name-as-directory (expand-file-name (or directory
2916                                                          default-directory))))                                                          default-directory))))
2917      (setq filename (expand-file-name filename))      (setq filename (expand-file-name filename))
2918      (let ((hf (find-file-name-handler filename 'file-local-copy))      (let ((hf (find-file-name-handler filename 'file-remote-p))
2919            (hd (find-file-name-handler directory 'file-local-copy)))            (hd (find-file-name-handler directory 'file-remote-p)))
       (when (and hf (not (get hf 'file-remote-p))) (setq hf nil))  
       (when (and hd (not (get hd 'file-remote-p))) (setq hd nil))  
2920        (if ;; Conditions for separate trees        (if ;; Conditions for separate trees
2921            (or            (or
2922             ;; Test for different drives on DOS/Windows             ;; Test for different drives on DOS/Windows
# Line 3010  the last real save, but optional arg FOR Line 3026  the last real save, but optional arg FOR
3026    
3027  (defcustom before-save-hook nil  (defcustom before-save-hook nil
3028    "Normal hook that is run before a buffer is saved to its file."    "Normal hook that is run before a buffer is saved to its file."
3029    :options '(copyright-update)    :options '(copyright-update time-stamp)
3030    :type 'hook    :type 'hook
3031    :group 'files)    :group 'files)
3032    
# Line 3466  this function is called. Line 3482  this function is called.
3482  The idea behind the NOCONFIRM argument is that it should be  The idea behind the NOCONFIRM argument is that it should be
3483  non-nil if the buffer is going to be reverted without asking the  non-nil if the buffer is going to be reverted without asking the
3484  user.  In such situations, one has to be careful with potentially  user.  In such situations, one has to be careful with potentially
3485  time consuming operations.")  time consuming operations.
3486    
3487    For more information on how this variable is used by Auto Revert mode,
3488    see Info node `(emacs-xtra)Supporting additional buffers'.")
3489    
3490  (defvar before-revert-hook nil  (defvar before-revert-hook nil
3491    "Normal hook for `revert-buffer' to run before reverting.    "Normal hook for `revert-buffer' to run before reverting.
# Line 4019  by `sh' are supported." Line 4038  by `sh' are supported."
4038    "Expand wildcard pattern PATTERN.    "Expand wildcard pattern PATTERN.
4039  This returns a list of file names which match the pattern.  This returns a list of file names which match the pattern.
4040    
4041  If PATTERN is written as an absolute relative file name,  If PATTERN is written as an absolute file name,
4042  the values are absolute also.  the values are absolute also.
4043    
4044  If PATTERN is written as a relative file name, it is interpreted  If PATTERN is written as a relative file name, it is interpreted
# Line 4230  This works by running a directory listin Line 4249  This works by running a directory listin
4249  whose name is in the variable `insert-directory-program'.  whose name is in the variable `insert-directory-program'.
4250  If WILDCARD, it also runs the shell specified by `shell-file-name'.  If WILDCARD, it also runs the shell specified by `shell-file-name'.
4251    
4252  When SWITCHES contains the long `--dired' option,this function  When SWITCHES contains the long `--dired' option, this function
4253  treats it specially, for the sake of dired.  However, the  treats it specially, for the sake of dired.  However, the
4254  normally equivalent short `-D' option is just passed on to  normally equivalent short `-D' option is just passed on to
4255  `insert-directory-program', as any other option."  `insert-directory-program', as any other option."
# Line 4307  normally equivalent short `-D' option is Line 4326  normally equivalent short `-D' option is
4326    
4327            ;; If `insert-directory-program' failed, signal an error.            ;; If `insert-directory-program' failed, signal an error.
4328            (unless (eq 0 result)            (unless (eq 0 result)
4329                ;; Delete the error message it may have output.
4330                (delete-region beg (point))
4331              ;; On non-Posix systems, we cannot open a directory, so              ;; On non-Posix systems, we cannot open a directory, so
4332              ;; don't even try, because that will always result in              ;; don't even try, because that will always result in
4333              ;; the ubiquitous "Access denied".  Instead, show the              ;; the ubiquitous "Access denied".  Instead, show the
# Line 4329  normally equivalent short `-D' option is Line 4350  normally equivalent short `-D' option is
4350              (when (looking-at "//SUBDIRED//")              (when (looking-at "//SUBDIRED//")
4351                (delete-region (point) (progn (forward-line 1) (point)))                (delete-region (point) (progn (forward-line 1) (point)))
4352                (forward-line -1))                (forward-line -1))
4353              (let ((end (line-end-position)))              (if (looking-at "//DIRED//")
4354                (forward-word 1)                  (let ((end (line-end-position)))
4355                (forward-char 3)                    (forward-word 1)
4356                (while (< (point) end)                    (forward-char 3)
4357                  (let ((start (+ beg (read (current-buffer))))                    (while (< (point) end)
4358                        (end (+ beg (read (current-buffer)))))                      (let ((start (+ beg (read (current-buffer))))
4359                    (if (= (char-after end) ?\n)                            (end (+ beg (read (current-buffer)))))
4360                        (put-text-property start end 'dired-filename t)                        (if (= (char-after end) ?\n)
4361                      ;; It seems that we can't trust ls's output as to                            (put-text-property start end 'dired-filename t)
4362                      ;; byte positions of filenames.                          ;; It seems that we can't trust ls's output as to
4363                      (put-text-property beg (point) 'dired-filename nil)                          ;; byte positions of filenames.
4364                      (end-of-line))))                          (put-text-property beg (point) 'dired-filename nil)
4365                (goto-char end)                          (end-of-line))))
4366                (beginning-of-line)                    (goto-char end)
4367                (delete-region (point) (progn (forward-line 2) (point)))))                    (beginning-of-line)
4368                      (delete-region (point) (progn (forward-line 2) (point))))
4369                  (forward-line 1)
4370                  (if (looking-at "//DIRED-OPTIONS//")
4371                      (delete-region (point) (progn (forward-line 1) (point)))
4372                    (forward-line 1))))
4373    
4374            ;; Now decode what read if necessary.            ;; Now decode what read if necessary.
4375            (let ((coding (or coding-system-for-read            (let ((coding (or coding-system-for-read
# Line 4416  be a predicate function such as `yes-or- Line 4442  be a predicate function such as `yes-or-
4442    :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)    :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
4443                   (const :tag "Ask with y-or-n-p" y-or-n-p)                   (const :tag "Ask with y-or-n-p" y-or-n-p)
4444                   (const :tag "Don't confirm" nil))                   (const :tag "Don't confirm" nil))
4445    :group 'emacs    :group 'convenience
4446    :version "21.1")    :version "21.1")
4447    
4448  (defun save-buffers-kill-emacs (&optional arg)  (defun save-buffers-kill-emacs (&optional arg)
# Line 4470  With prefix arg, silently save all file- Line 4496  With prefix arg, silently save all file-
4496          ;; Get a list of the indices of the args which are file names.          ;; Get a list of the indices of the args which are file names.
4497          (file-arg-indices          (file-arg-indices
4498           (cdr (or (assq operation           (cdr (or (assq operation
4499                          ;; The first five are special because they                          ;; The first six are special because they
4500                          ;; return a file name.  We want to include the /:                          ;; return a file name.  We want to include the /:
4501                          ;; in the return value.                          ;; in the return value.
4502                          ;; So just avoid stripping it in the first place.                          ;; So just avoid stripping it in the first place.
# Line 4479  With prefix arg, silently save all file- Line 4505  With prefix arg, silently save all file-
4505                            (file-name-as-directory . nil)                            (file-name-as-directory . nil)
4506                            (directory-file-name . nil)                            (directory-file-name . nil)
4507                            (file-name-sans-versions . nil)                            (file-name-sans-versions . nil)
4508                              (find-backup-file-name . nil)
4509                            ;; `identity' means just return the first arg                            ;; `identity' means just return the first arg
4510                            ;; as stripped of its quoting.                            ;; not stripped of its quoting.
4511                            (substitute-in-file-name . identity)                            (substitute-in-file-name identity)
4512                              ;; `add' means add "/:" to the result.
4513                              (file-truename add 0)
4514                              ;; `quote' means add "/:" to buffer-file-name.
4515                              (insert-file-contents quote 0)
4516                              ;; `unquote-then-quote' means set buffer-file-name
4517                              ;; temporarily to unquoted filename.
4518                              (verify-visited-file-modtime unquote-then-quote)
4519                              ;; List the arguments which are filenames.
4520                            (file-name-completion 1)                            (file-name-completion 1)
4521                            (file-name-all-completions 1)                            (file-name-all-completions 1)
4522                              (write-region 2 5)
4523                            (rename-file 0 1)                            (rename-file 0 1)
4524                            (copy-file 0 1)                            (copy-file 0 1)
4525                            (make-symbolic-link 0 1)                            (make-symbolic-link 0 1)
# Line 4491  With prefix arg, silently save all file- Line 4527  With prefix arg, silently save all file-
4527                    ;; For all other operations, treat the first argument only                    ;; For all other operations, treat the first argument only
4528                    ;; as the file name.                    ;; as the file name.
4529                    '(nil 0))))                    '(nil 0))))
4530            method
4531          ;; Copy ARGUMENTS so we can replace elements in it.          ;; Copy ARGUMENTS so we can replace elements in it.
4532          (arguments (copy-sequence arguments)))          (arguments (copy-sequence arguments)))
4533      ;; Strip off the /: from the file names that have this handler.      (if (symbolp (car file-arg-indices))
4534            (setq method (pop file-arg-indices)))
4535        ;; Strip off the /: from the file names that have it.
4536      (save-match-data      (save-match-data
4537        (while (consp file-arg-indices)        (while (consp file-arg-indices)
4538          (let ((pair (nthcdr (car file-arg-indices) arguments)))          (let ((pair (nthcdr (car file-arg-indices) arguments)))
# Line 4504  With prefix arg, silently save all file- Line 4543  With prefix arg, silently save all file-
4543                             "/"                             "/"
4544                           (substring (car pair) 2)))))                           (substring (car pair) 2)))))
4545          (setq file-arg-indices (cdr file-arg-indices))))          (setq file-arg-indices (cdr file-arg-indices))))
4546      (if (eq file-arg-indices 'identity)      (cond ((eq method 'identity)
4547          (car arguments)             (car arguments))
4548        (apply operation arguments))))            ((eq method 'add)
4549               (concat "/:" (apply operation arguments)))
4550              ((eq method 'quote)
4551               (prog1 (apply operation arguments)
4552                 (setq buffer-file-name (concat "/:" buffer-file-name))))
4553              ((eq method 'unquote-then-quote)
4554               (let (res)
4555                 (setq buffer-file-name (substring buffer-file-name 2))
4556                 (setq res (apply operation arguments))
4557                 (setq buffer-file-name (concat "/:" buffer-file-name))
4558                 res))
4559              (t
4560               (apply operation arguments)))))
4561    
4562  (define-key ctl-x-map "\C-f" 'find-file)  (define-key ctl-x-map "\C-f" 'find-file)
4563  (define-key ctl-x-map "\C-r" 'find-file-read-only)  (define-key ctl-x-map "\C-r" 'find-file-read-only)

Legend:
Removed from v.1.666.2.2  
changed lines
  Added in v.1.666.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26