Mercurial > emacs

comparison lisp/files.el @ 83241:3dcba0bc766b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged in changes from CVS trunk. (Long time no see!) :-) Patches applied: * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-83 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-84 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-1 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-2 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-3 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-4 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-5 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-6 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-7 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-8 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-9 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-10 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-11 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-12 Remove "-face" suffix from lazy-highlight face name * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-13 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-14 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-15 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-16 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-17 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-18 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-19 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-20 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-21 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-22 <no summary provided> * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-23 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-24 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-25 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-26 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-27 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-28 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-29 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-30 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-31 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-32 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-33 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-34 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-35 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-36 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-37 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-38 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-39 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-40 Fix regressions from latest reftex update * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-41 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-42 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-43 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-44 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-45 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-46 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-47 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-48 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-49 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-50 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-51 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-52 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-53 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-54 Update from CVS: lisp/cus-start.el (all): Add `undo-outer-limit'. * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-55 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-56 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-57 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-58 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-59 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-60 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-61 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-62 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-63 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-64 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-65 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-66 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-67 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-68 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-69 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-70 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-71 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-72 src/dispextern.h (xassert): Enable unconditionally. * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-73 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-74 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-75 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--base-0 tag of miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-82 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-1 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-2 Merge from miles@gnu.org--gnu-2004 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-3 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-4 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-5 Update from CVS: exi/gnus-faq.texi ([4.1]): Typo. * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-6 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-7 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-8 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-9 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-10 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-11 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-281
author Karoly Lorentey <lorentey@elte.hu>
date Thu, 03 Feb 2005 23:28:36 +0000
parents 025da3ba778e 62b62ef62937
children 89ac10c67e45
comparison
equal deleted inserted replaced
83240:62cbc3806a41 83241:3dcba0bc766b
1 ;;; files.el --- file input and output commands for Emacs 1 ;;; files.el --- file input and output commands for Emacs
2 2
3 ;; Copyright (C) 1985,86,87,92,93,94,95,96,97,98,99,2000,01,02,03,2004 3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
4 ;;; Free Software Foundation, Inc. 4 ;; 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
5 5
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
9 9
1854 Visiting a file whose name matches REGEXP specifies FUNCTION as the 1854 Visiting a file whose name matches REGEXP specifies FUNCTION as the
1855 mode function to use. FUNCTION will be called, unless it is nil. 1855 mode function to use. FUNCTION will be called, unless it is nil.
1856 1856
1857 If the element has the form (REGEXP FUNCTION NON-NIL), then after 1857 If the element has the form (REGEXP FUNCTION NON-NIL), then after
1858 calling FUNCTION (if it's not nil), we delete the suffix that matched 1858 calling FUNCTION (if it's not nil), we delete the suffix that matched
1859 REGEXP and search the list again for another match.") 1859 REGEXP and search the list again for another match.
1860 1860
1861 If the file name matches `inhibit-first-line-modes-regexps',
1862 then `auto-mode-alist' is not processed.
1863
1864 See also `interpreter-mode-alist', which detects executable script modes
1865 based on the interpreters they specify to run,
1866 and `magic-mode-alist', which determines modes based on file contents.")
1861 1867
1862 (defvar interpreter-mode-alist 1868 (defvar interpreter-mode-alist
1863 ;; Note: The entries for the modes defined in cc-mode.el (awk-mode 1869 ;; Note: The entries for the modes defined in cc-mode.el (awk-mode
1864 ;; and pike-mode) are added through autoload directives in that 1870 ;; and pike-mode) are added through autoload directives in that
1865 ;; file. That way is discouraged since it spreads out the 1871 ;; file. That way is discouraged since it spreads out the
1900 ("pg" . text-mode) 1906 ("pg" . text-mode)
1901 ("make" . makefile-mode) ; Debian uses this 1907 ("make" . makefile-mode) ; Debian uses this
1902 ("guile" . scheme-mode) 1908 ("guile" . scheme-mode)
1903 ("clisp" . lisp-mode))) 1909 ("clisp" . lisp-mode)))
1904 "Alist mapping interpreter names to major modes. 1910 "Alist mapping interpreter names to major modes.
1905 This alist applies to files whose first line starts with `#!'. 1911 This is used for files whose first lines match `auto-mode-interpreter-regexp'.
1906 Each element looks like (INTERPRETER . MODE). 1912 Each element looks like (INTERPRETER . MODE).
1907 The car of each element is compared with 1913 The car of each element is compared with
1908 the name of the interpreter specified in the first line. 1914 the name of the interpreter specified in the first line.
1909 If it matches, mode MODE is selected.") 1915 If it matches, mode MODE is selected.
1916
1917 See also `auto-mode-alist'.")
1910 1918
1911 (defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'") 1919 (defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'")
1912 "List of regexps; if one matches a file name, don't look for `-*-'.") 1920 "List of regexps; if one matches a file name, don't look for `-*-'.")
1913 1921
1914 (defvar inhibit-first-line-modes-suffixes nil 1922 (defvar inhibit-first-line-modes-suffixes nil
1933 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") 1941 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
1934 (comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)"))) 1942 (comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)")))
1935 (concat "\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<" 1943 (concat "\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<"
1936 comment-re "*" 1944 comment-re "*"
1937 "\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\s *" comment-re "*\\)?" 1945 "\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\s *" comment-re "*\\)?"
1938 "[Hh][Tt][Mm][Ll]")) . html-mode) 1946 "[Hh][Tt][Mm][Ll]"))
1947 . html-mode)
1939 ;; These two must come after html, because they are more general: 1948 ;; These two must come after html, because they are more general:
1940 ("<\\?xml " . xml-mode) 1949 ("<\\?xml " . xml-mode)
1941 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") 1950 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
1942 (comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)"))) 1951 (comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)")))
1943 (concat "\\s *<" comment-re "*!DOCTYPE ")) . sgml-mode) 1952 (concat "\\s *<" comment-re "*!DOCTYPE "))
1953 . sgml-mode)
1944 ("%![^V]" . ps-mode) 1954 ("%![^V]" . ps-mode)
1945 ("# xmcd " . conf-unix-mode)) 1955 ("# xmcd " . conf-unix-mode))
1946 "Alist of buffer beginnings vs. corresponding major mode functions. 1956 "Alist of buffer beginnings vs. corresponding major mode functions.
1947 Each element looks like (REGEXP . FUNCTION). FUNCTION will be 1957 Each element looks like (REGEXP . FUNCTION). FUNCTION will be
1948 called, unless it is nil (to allow `auto-mode-alist' to override).") 1958 called, unless it is nil (to allow `auto-mode-alist' to override).")
2200 (and local-enable-local-variables enable-local-variables))) 2210 (and local-enable-local-variables enable-local-variables)))
2201 ;; Look for "Local variables:" line in last page. 2211 ;; Look for "Local variables:" line in last page.
2202 (save-excursion 2212 (save-excursion
2203 (goto-char (point-max)) 2213 (goto-char (point-max))
2204 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) 2214 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
2205 (if (let ((case-fold-search t)) 2215 (when (let ((case-fold-search t))
2206 (and (search-forward "Local Variables:" nil t) 2216 (and (search-forward "Local Variables:" nil t)
2207 (or (eq enable-local-variables t) 2217 (or (eq enable-local-variables t)
2208 mode-only 2218 mode-only
2209 (and enable-local-variables 2219 (and enable-local-variables
2210 (save-window-excursion 2220 (save-window-excursion
2211 (switch-to-buffer (current-buffer)) 2221 (switch-to-buffer (current-buffer))
2212 (save-excursion 2222 (save-excursion
2213 (beginning-of-line) 2223 (beginning-of-line)
2214 (set-window-start (selected-window) (point))) 2224 (set-window-start (selected-window) (point)))
2215 (y-or-n-p (format "Set local variables as specified at end of %s? " 2225 (y-or-n-p (format "Set local variables as specified at end of %s? "
2216 (if buffer-file-name 2226 (if buffer-file-name
2217 (file-name-nondirectory 2227 (file-name-nondirectory
2218 buffer-file-name) 2228 buffer-file-name)
2219 (concat "buffer " 2229 (concat "buffer "
2220 (buffer-name)))))))))) 2230 (buffer-name))))))))))
2221 (let (prefix suffix beg 2231 (skip-chars-forward " \t")
2222 (enable-local-eval enable-local-eval)) 2232 (let ((enable-local-eval enable-local-eval)
2223 ;; The prefix is what comes before "local variables:" in its line. 2233 ;; suffix is what comes after "local variables:" in its line.
2224 ;; The suffix is what comes after "local variables:" in its line. 2234 (suffix
2225 (skip-chars-forward " \t") 2235 (concat
2226 (or (eolp) 2236 (regexp-quote (buffer-substring (point) (line-end-position)))
2227 (setq suffix (buffer-substring (point) 2237 "$"))
2228 (progn (end-of-line) (point))))) 2238 ;; prefix is what comes before "local variables:" in its line.
2229 (goto-char (match-beginning 0)) 2239 (prefix
2230 (or (bolp) 2240 (concat "^" (regexp-quote
2231 (setq prefix 2241 (buffer-substring (line-beginning-position)
2232 (buffer-substring (point) 2242 (match-beginning 0)))))
2233 (progn (beginning-of-line) (point))))) 2243 beg)
2234 2244
2235 (setq prefix (if prefix (regexp-quote prefix) "^")) 2245 (forward-line 1)
2236 (if suffix (setq suffix (concat (regexp-quote suffix) "$"))) 2246 (let ((startpos (point))
2237 (forward-line 1) 2247 endpos
2238 (let ((startpos (point)) 2248 (thisbuf (current-buffer)))
2239 endpos 2249 (save-excursion
2240 (thisbuf (current-buffer))) 2250 (if (not (re-search-forward
2241 (save-excursion 2251 (concat prefix "[ \t]*End:[ \t]*" suffix)
2242 (if (not (re-search-forward 2252 nil t))
2243 (concat (or prefix "") 2253 (error "Local variables list is not properly terminated"))
2244 "[ \t]*End:[ \t]*" 2254 (beginning-of-line)
2245 (or suffix "")) 2255 (setq endpos (point)))
2246 nil t)) 2256
2247 (error "Local variables list is not properly terminated")) 2257 (with-temp-buffer
2248 (beginning-of-line) 2258 (insert-buffer-substring thisbuf startpos endpos)
2249 (setq endpos (point))) 2259 (goto-char (point-min))
2250 2260 (subst-char-in-region (point) (point-max) ?\^m ?\n)
2251 (with-temp-buffer 2261 (while (not (eobp))
2252 (insert-buffer-substring thisbuf startpos endpos) 2262 ;; Discard the prefix.
2253 (goto-char (point-min)) 2263 (if (looking-at prefix)
2254 (subst-char-in-region (point) (point-max) 2264 (delete-region (point) (match-end 0))
2255 ?\^m ?\n) 2265 (error "Local variables entry is missing the prefix"))
2256 (while (not (eobp)) 2266 (end-of-line)
2257 ;; Discard the prefix, if any. 2267 ;; Discard the suffix.
2258 (if prefix 2268 (if (looking-back suffix)
2259 (if (looking-at prefix) 2269 (delete-region (match-beginning 0) (point))
2260 (delete-region (point) (match-end 0)) 2270 (error "Local variables entry is missing the suffix"))
2261 (error "Local variables entry is missing the prefix"))) 2271 (forward-line 1))
2262 (end-of-line) 2272 (goto-char (point-min))
2263 ;; Discard the suffix, if any. 2273
2264 (if suffix 2274 (while (not (eobp))
2265 (if (looking-back suffix) 2275 ;; Find the variable name; strip whitespace.
2266 (delete-region (match-beginning 0) (point)) 2276 (skip-chars-forward " \t")
2267 (error "Local variables entry is missing the suffix"))) 2277 (setq beg (point))
2268 (forward-line 1)) 2278 (skip-chars-forward "^:\n")
2269 (goto-char (point-min)) 2279 (if (eolp) (error "Missing colon in local variables entry"))
2270 2280 (skip-chars-backward " \t")
2271 (while (not (eobp)) 2281 (let* ((str (buffer-substring beg (point)))
2272 ;; Find the variable name; strip whitespace. 2282 (var (read str))
2273 (skip-chars-forward " \t") 2283 val)
2274 (setq beg (point)) 2284 ;; Read the variable value.
2275 (skip-chars-forward "^:\n") 2285 (skip-chars-forward "^:")
2276 (if (eolp) (error "Missing colon in local variables entry")) 2286 (forward-char 1)
2277 (skip-chars-backward " \t") 2287 (setq val (read (current-buffer)))
2278 (let* ((str (buffer-substring beg (point))) 2288 (if mode-only
2279 (var (read str)) 2289 (if (eq var 'mode)
2280 val) 2290 (setq mode-specified t))
2281 ;; Read the variable value. 2291 ;; Set the variable. "Variables" mode and eval are funny.
2282 (skip-chars-forward "^:") 2292 (with-current-buffer thisbuf
2283 (forward-char 1) 2293 (hack-one-local-variable var val))))
2284 (setq val (read (current-buffer))) 2294 (forward-line 1)))))))
2285 (if mode-only
2286 (if (eq var 'mode)
2287 (setq mode-specified t))
2288 ;; Set the variable. "Variables" mode and eval are funny.
2289 (with-current-buffer thisbuf
2290 (hack-one-local-variable var val))))
2291 (forward-line 1)))))))
2292 (unless mode-only 2295 (unless mode-only
2293 (run-hooks 'hack-local-variables-hook)) 2296 (run-hooks 'hack-local-variables-hook))
2294 mode-specified)) 2297 mode-specified))
2295 2298
2296 (defvar ignored-local-variables () 2299 (defvar ignored-local-variables ()
2839 :type '(repeat (cons (regexp :tag "Regexp matching filename") 2842 :type '(repeat (cons (regexp :tag "Regexp matching filename")
2840 (directory :tag "Backup directory name")))) 2843 (directory :tag "Backup directory name"))))
2841 2844
2842 (defun normal-backup-enable-predicate (name) 2845 (defun normal-backup-enable-predicate (name)
2843 "Default `backup-enable-predicate' function. 2846 "Default `backup-enable-predicate' function.
2844 Checks for files in `temporary-file-directory' or 2847 Checks for files in `temporary-file-directory',
2845 `small-temporary-file-directory'." 2848 `small-temporary-file-directory', and /tmp."
2846 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil 2849 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
2847 name 0 nil))) 2850 name 0 nil)))
2848 ;; Directory is under temporary-file-directory. 2851 ;; Directory is under temporary-file-directory.
2849 (and (not (eq comp t)) 2852 (and (not (eq comp t))
2850 (< comp (- (length temporary-file-directory))))) 2853 (< comp (- (length temporary-file-directory)))))
2854 (let ((comp (compare-strings "/tmp" 0 nil
2855 name 0 nil)))
2856 ;; Directory is under /tmp.
2857 (and (not (eq comp t))
2858 (< comp (- (length "/tmp")))))
2851 (if small-temporary-file-directory 2859 (if small-temporary-file-directory
2852 (let ((comp (compare-strings small-temporary-file-directory 2860 (let ((comp (compare-strings small-temporary-file-directory
2853 0 nil 2861 0 nil
2854 name 0 nil))) 2862 name 0 nil)))
2855 ;; Directory is under small-temporary-file-directory. 2863 ;; Directory is under small-temporary-file-directory.
3269 ;; This does the "real job" of writing a buffer into its visited file 3277 ;; This does the "real job" of writing a buffer into its visited file
3270 ;; and making a backup file. This is what is normally done 3278 ;; and making a backup file. This is what is normally done
3271 ;; but inhibited if one of write-file-functions returns non-nil. 3279 ;; but inhibited if one of write-file-functions returns non-nil.
3272 ;; It returns a value (MODES . BACKUPNAME), like backup-buffer. 3280 ;; It returns a value (MODES . BACKUPNAME), like backup-buffer.
3273 (defun basic-save-buffer-1 () 3281 (defun basic-save-buffer-1 ()
3274 (if save-buffer-coding-system 3282 (prog1
3275 (let ((coding-system-for-write save-buffer-coding-system)) 3283 (if save-buffer-coding-system
3284 (let ((coding-system-for-write save-buffer-coding-system))
3285 (basic-save-buffer-2))
3276 (basic-save-buffer-2)) 3286 (basic-save-buffer-2))
3277 (basic-save-buffer-2)) 3287 (setq buffer-file-coding-system-explicit last-coding-system-used)))
3278 (setq buffer-file-coding-system-explicit last-coding-system-used))
3279 3288
3280 ;; This returns a value (MODES . BACKUPNAME), like backup-buffer. 3289 ;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
3281 (defun basic-save-buffer-2 () 3290 (defun basic-save-buffer-2 ()
3282 (let (tempsetmodes setmodes) 3291 (let (tempsetmodes setmodes)
3283 (if (not (file-writable-p buffer-file-name)) 3292 (if (not (file-writable-p buffer-file-name))
4544 (error "Listing directory failed but `access-file' worked"))) 4553 (error "Listing directory failed but `access-file' worked")))
4545 4554
4546 (when (if (stringp switches) 4555 (when (if (stringp switches)
4547 (string-match "--dired\\>" switches) 4556 (string-match "--dired\\>" switches)
4548 (member "--dired" switches)) 4557 (member "--dired" switches))
4558 ;; The following overshoots by one line for an empty
4559 ;; directory listed with "--dired", but without "-a"
4560 ;; switch, where the ls output contains a
4561 ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
4562 ;; We take care of that case later.
4549 (forward-line -2) 4563 (forward-line -2)
4550 (when (looking-at "//SUBDIRED//") 4564 (when (looking-at "//SUBDIRED//")
4551 (delete-region (point) (progn (forward-line 1) (point))) 4565 (delete-region (point) (progn (forward-line 1) (point)))
4552 (forward-line -1)) 4566 (forward-line -1))
4553 (when (looking-at "//DIRED//") 4567 (if (looking-at "//DIRED//")
4554 (let ((end (line-end-position)) 4568 (let ((end (line-end-position))
4555 (linebeg (point)) 4569 (linebeg (point))
4556 error-lines) 4570 error-lines)
4557 ;; Find all the lines that are error messages, 4571 ;; Find all the lines that are error messages,
4558 ;; and record the bounds of each one. 4572 ;; and record the bounds of each one.
4559 (goto-char (point-min)) 4573 (goto-char beg)
4560 (while (< (point) linebeg) 4574 (while (< (point) linebeg)
4561 (or (eql (following-char) ?\s) 4575 (or (eql (following-char) ?\s)
4562 (push (list (point) (line-end-position)) error-lines)) 4576 (push (list (point) (line-end-position)) error-lines))
4563 (forward-line 1)) 4577 (forward-line 1))
4564 (setq error-lines (nreverse error-lines)) 4578 (setq error-lines (nreverse error-lines))
4565 ;; Now read the numeric positions of file names. 4579 ;; Now read the numeric positions of file names.
4566 (goto-char linebeg) 4580 (goto-char linebeg)
4567 (forward-word 1) 4581 (forward-word 1)
4568 (forward-char 3) 4582 (forward-char 3)
4569 (while (< (point) end) 4583 (while (< (point) end)
4570 (let ((start (insert-directory-adj-pos 4584 (let ((start (insert-directory-adj-pos
4585 (+ beg (read (current-buffer)))
4586 error-lines))
4587 (end (insert-directory-adj-pos
4571 (+ beg (read (current-buffer))) 4588 (+ beg (read (current-buffer)))
4572 error-lines)) 4589 error-lines)))
4573 (end (insert-directory-adj-pos 4590 (if (memq (char-after end) '(?\n ?\ ))
4574 (+ beg (read (current-buffer))) 4591 ;; End is followed by \n or by " -> ".
4575 error-lines))) 4592 (put-text-property start end 'dired-filename t)
4576 (if (memq (char-after end) '(?\n ?\ )) 4593 ;; It seems that we can't trust ls's output as to
4577 ;; End is followed by \n or by " -> ". 4594 ;; byte positions of filenames.
4578 (put-text-property start end 'dired-filename t) 4595 (put-text-property beg (point) 'dired-filename nil)
4579 ;; It seems that we can't trust ls's output as to 4596 (end-of-line))))
4580 ;; byte positions of filenames. 4597 (goto-char end)
4581 (put-text-property beg (point) 'dired-filename nil) 4598 (beginning-of-line)
4582 (end-of-line)))) 4599 (delete-region (point) (progn (forward-line 1) (point))))
4583 (goto-char end) 4600 ;; Take care of the case where the ls output contains a
4584 (beginning-of-line) 4601 ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
4585 (delete-region (point) (progn (forward-line 2) (point)))) 4602 ;; and we went one line too far back (see above).
4586 (forward-line 1) 4603 (forward-line 1))
4587 (if (looking-at "//DIRED-OPTIONS//") 4604 (if (looking-at "//DIRED-OPTIONS//")
4588 (delete-region (point) (progn (forward-line 1) (point))) 4605 (delete-region (point) (progn (forward-line 1) (point)))))
4589 (forward-line 1))))
4590 4606
4591 ;; Now decode what read if necessary. 4607 ;; Now decode what read if necessary.
4592 (let ((coding (or coding-system-for-read 4608 (let ((coding (or coding-system-for-read
4593 file-name-coding-system 4609 file-name-coding-system
4594 default-file-name-coding-system 4610 default-file-name-coding-system