:version "21.1")
(defcustom save-abbrevs t
- "*Non-nil means save word abbrevs too when files are saved."
- :type 'boolean
+ "*Non-nil means save word abbrevs too when files are saved.
+If `silently', don't ask the user before saving."
+ :type '(choice (const t) (const nil) (const silently))
:group 'abbrev)
(defcustom find-file-run-dired t
then we do not set anything but the major mode,
and we don't even do that unless it would come from the file name."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
- (let (beg end done modes)
+ (let (end done modes)
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
(and enable-local-variables
- ;; Don't look for -*- if this file name matches any
- ;; 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 "-*-" (save-excursion
- ;; 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.
- (end-of-line (and (looking-at "^#!") 2))
- (point)) t)
- (progn
- (skip-chars-forward " \t")
- (setq beg (point))
- (search-forward "-*-"
- (save-excursion (end-of-line) (point))
- t))
- (progn
- (forward-char -3)
- (skip-chars-backward " \t")
- (setq end (point))
- (goto-char beg)
- (if (save-excursion (search-forward ":" end t))
- ;; Find all specifications for the `mode:' variable
- ;; and execute them left to right.
- (while (let ((case-fold-search t))
- (or (and (looking-at "mode:")
- (goto-char (match-end 0)))
- (re-search-forward "[ \t;]mode:" end t)))
- (skip-chars-forward " \t")
- (setq beg (point))
+ (setq end (set-auto-mode-1))
+ (if (save-excursion (search-forward ":" end t))
+ ;; Find all specifications for the `mode:' variable
+ ;; and execute them left to right.
+ (while (let ((case-fold-search t))
+ (or (and (looking-at "mode:")
+ (goto-char (match-end 0)))
+ (re-search-forward "[ \t;]mode:" end t)))
+ (skip-chars-forward " \t")
+ (let ((beg (point)))
(if (search-forward ";" end t)
(forward-char -1)
(goto-char end))
(skip-chars-backward " \t")
(push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
- modes))
- ;; Simple -*-MODE-*- case.
- (push (intern (concat (downcase (buffer-substring beg end))
- "-mode"))
- modes)))))
+ modes)))
+ ;; Simple -*-MODE-*- case.
+ (push (intern (concat (downcase (buffer-substring (point) end))
+ "-mode"))
+ modes))))
;; If we found modes to use, invoke them now,
;; outside the save-excursion.
(unless just-from-file-name
(if elt
(funcall (cdr elt))))))))))))
+
+(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; point may be changed."
+ (let (beg end)
+ (and
+ ;; Don't look for -*- if this file name matches any
+ ;; 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 "-*-" (save-excursion
+ ;; 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.
+ (end-of-line (and (looking-at "^#!") 2))
+ (point)) t)
+ (progn
+ (skip-chars-forward " \t")
+ (setq beg (point))
+ (search-forward "-*-"
+ (save-excursion (end-of-line) (point))
+ t))
+ (progn
+ (forward-char -3)
+ (skip-chars-backward " \t")
+ (setq end (point))
+ (goto-char beg)
+ end))))
+
(defun hack-local-variables-prop-line ()
"Set local variables specified in the -*- line.
Ignore any specification for `mode:' and `coding:';
(save-excursion
(goto-char (point-min))
(let ((result nil)
- (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point)))
+ (end (set-auto-mode-1))
(enable-local-variables
(and local-enable-local-variables enable-local-variables)))
;; Parse the -*- line into the `result' alist.
- (cond ((not (search-forward "-*-" end t))
- ;; doesn't have one.
+ (cond ((not end)
nil)
((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
;; Simple form: "-*- MODENAME -*-". Already handled.
(t
;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
;; (last ";" is optional).
- (save-excursion
- (if (search-forward "-*-" end t)
- (setq end (- (point) 3))
- (error "-*- not terminated before end of line")))
(while (< (point) end)
(or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
(error "Malformed -*- line"))
;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
(put 'outline-level 'risky-local-variable t)
(put 'rmail-output-file-alist 'risky-local-variable t)
+(put 'font-lock-defaults 'risky-local-variable t)
;; This one is safe because the user gets to check it before it is used.
(put 'compile-command 'safe-local-variable t)
;; Likewise for setting hook variables.
((or (get var 'risky-local-variable)
(and
- (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$"
+ (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$"
(symbol-name var))
(not (get var 'safe-local-variable))))
;; Permit evalling a put of a harmless property.
(and save-abbrevs abbrevs-changed
(progn
(if (or arg
+ (eq save-abbrevs 'silently)
(y-or-n-p (format "Save abbrevs in %s? "
abbrev-file-name)))
(write-abbrev-file nil))
(defvar insert-directory-program "ls"
"Absolute or relative name of the `ls' program used by `insert-directory'.")
+(defcustom directory-free-space-program "df"
+ "*Program to get the amount of free space on a file system.
+We assume the output has the format of `df'.
+The value of this variable must be just a command name or file name;
+if you want to specify options, use `directory-free-space-args'.
+
+A value of nil disables this feature.
+
+If the function `file-system-info' is defined, it is always used in
+preference to the program given by this variable."
+ :type '(choice (string :tag "Program") (const :tag "None" nil))
+ :group 'dired)
+
+(defcustom directory-free-space-args "-Pk"
+ "*Options to use when running `directory-free-space-program'."
+ :type 'string
+ :group 'dired)
+
+(defun get-free-disk-space (dir)
+ "Return the mount of free space on directory DIR's file system.
+The result is a string that gives the number of free 1KB blocks,
+or nil if the system call or the program which retrieve the infornmation
+fail.
+
+This function calls `file-system-info' if it is available, or invokes the
+program specified by `directory-free-space-program' if that is non-nil."
+ ;; Try to find the number of free blocks. Non-Posix systems don't
+ ;; always have df, but might have an equivalent system call.
+ (if (fboundp 'file-system-info)
+ (let ((fsinfo (file-system-info dir)))
+ (if fsinfo
+ (format "%.0f" (/ (nth 2 fsinfo) 1024))))
+ (save-match-data
+ (with-temp-buffer
+ (when (and directory-free-space-program
+ (zerop (call-process directory-free-space-program
+ nil t nil
+ directory-free-space-args
+ dir)))
+ ;; Usual format is a header line followed by a line of
+ ;; numbers.
+ (goto-char (point-min))
+ (forward-line 1)
+ (if (not (eobp))
+ (progn
+ ;; Move to the end of the "available blocks" number.
+ (skip-chars-forward "^ \t")
+ (forward-word 3)
+ ;; Copy it into AVAILABLE.
+ (let ((end (point)))
+ (forward-word -1)
+ (buffer-substring (point) end)))))))))
+
+
;; insert-directory
;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
;; FULL-DIRECTORY-P is nil.
;; We need the directory in order to find the right handler.
(let ((handler (find-file-name-handler (expand-file-name file)
'insert-directory)))
- (if handler
+ (if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
(if (eq system-type 'vax-vms)
(vms-read-directory file switches (current-buffer))
- (let* ((coding-system-for-read
- (and enable-multibyte-characters
- (or file-name-coding-system
- default-file-name-coding-system)))
- ;; This is to control encoding the arguments in call-process.
- (coding-system-for-write coding-system-for-read)
- (result
- (if wildcard
- ;; Run ls in the directory of the file pattern we asked for
- (let ((default-directory
- (if (file-name-absolute-p file)
- (file-name-directory file)
- (file-name-directory (expand-file-name file))))
- (pattern (file-name-nondirectory file)))
- (call-process
- shell-file-name nil t nil
- "-c" (concat (if (memq system-type '(ms-dos windows-nt))
- ""
- "\\") ; Disregard Unix shell aliases!
- insert-directory-program
- " -d "
- (if (stringp switches)
- switches
- (mapconcat 'identity switches " "))
- " -- "
- ;; Quote some characters that have
- ;; special meanings in shells; but
- ;; don't quote the wildcards--we
- ;; want them to be special. We
- ;; also currently don't quote the
- ;; quoting characters in case
- ;; people want to use them
- ;; explicitly to quote wildcard
- ;; characters.
- (shell-quote-wildcard-pattern pattern))))
- ;; SunOS 4.1.3, SVr4 and others need the "." to list the
- ;; directory if FILE is a symbolic link.
- (apply 'call-process
- insert-directory-program nil t nil
- (append
- (if (listp switches) switches
- (unless (equal switches "")
- ;; Split the switches at any spaces so we can
- ;; pass separate options as separate args.
- (split-string switches)))
- ;; Avoid lossage if FILE starts with `-'.
- '("--")
- (progn
- (if (string-match "\\`~" file)
- (setq file (expand-file-name file)))
- (list
- (if full-directory-p
- (concat (file-name-as-directory file) ".")
- file))))))))
+ (let (result available)
+
+ ;; Read the actual directory using `insert-directory-program'.
+ ;; RESULT gets the status code.
+ (let ((coding-system-for-read
+ (and enable-multibyte-characters
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ ;; This is to control encoding the arguments in call-process.
+ (coding-system-for-write coding-system-for-read))
+ (setq result
+ (if wildcard
+ ;; Run ls in the directory part of the file pattern
+ ;; using the last component as argument.
+ (let ((default-directory
+ (if (file-name-absolute-p file)
+ (file-name-directory file)
+ (file-name-directory (expand-file-name file))))
+ (pattern (file-name-nondirectory file)))
+ (call-process
+ shell-file-name nil t nil
+ "-c"
+ (concat (if (memq system-type '(ms-dos windows-nt))
+ ""
+ "\\") ; Disregard Unix shell aliases!
+ insert-directory-program
+ " -d "
+ (if (stringp switches)
+ switches
+ (mapconcat 'identity switches " "))
+ " -- "
+ ;; Quote some characters that have
+ ;; special meanings in shells; but
+ ;; don't quote the wildcards--we want
+ ;; them to be special. We also
+ ;; currently don't quote the quoting
+ ;; characters in case people want to
+ ;; use them explicitly to quote
+ ;; wildcard characters.
+ (shell-quote-wildcard-pattern pattern))))
+ ;; SunOS 4.1.3, SVr4 and others need the "." to list the
+ ;; directory if FILE is a symbolic link.
+ (apply 'call-process
+ insert-directory-program nil t nil
+ (append
+ (if (listp switches) switches
+ (unless (equal switches "")
+ ;; Split the switches at any spaces so we can
+ ;; pass separate options as separate args.
+ (split-string switches)))
+ ;; Avoid lossage if FILE starts with `-'.
+ '("--")
+ (progn
+ (if (string-match "\\`~" file)
+ (setq file (expand-file-name file)))
+ (list
+ (if full-directory-p
+ (concat (file-name-as-directory file) ".")
+ file))))))))
+
+ ;; If `insert-directory-program' failed, signal an error.
(if (/= result 0)
- ;; We get here if `insert-directory-program' failed.
;; On non-Posix systems, we cannot open a directory, so
;; don't even try, because that will always result in
- ;; the ubiquitous "Access denied". Instead, show them
- ;; the `ls' command line and let them guess what went
- ;; wrong.
+ ;; the ubiquitous "Access denied". Instead, show the
+ ;; command line so the user can try to guess what went wrong.
(if (and (file-directory-p file)
(memq system-type '(ms-dos windows-nt)))
(error
(if (listp switches) (concat switches) switches)
file result)
;; Unix. Access the file to get a suitable error.
- (access-file file "Reading directory"))
- ;; Replace "total" with "used", to avoid confusion.
- ;; Add in the amount of free space.
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward "^total" nil t)
- (replace-match "used")
- (end-of-line)
- (let (available)
- (with-temp-buffer
- (call-process "df" nil t nil ".")
- (goto-char (point-min))
- (forward-line 1)
- (skip-chars-forward "^ \t")
- (forward-word 3)
- (let ((end (point)))
- (forward-word -1)
- (setq available (buffer-substring (point) end))))
+ (access-file file "Reading directory")
+ (error "Listing directory failed but `access-file' worked")))
+
+ ;; Try to insert the amount of free space.
+ (save-excursion
+ (goto-char (point-min))
+ ;; First find the line to put it on.
+ (when (re-search-forward "^total" nil t)
+ (let ((available (get-free-disk-space ".")))
+ (when available
+ ;; Replace "total" with "used", to avoid confusion.
+ (replace-match "total used in directory")
+ (end-of-line)
(insert " available " available))))))))))
(defun insert-directory-safely (file switches
HCoop / bpt / emacs.git / blobdiff