;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996,
;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007 Free Software Foundation, Inc.
+;; 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
done when setting up the default directory of a newly visited file.
*Every* FROM string should start with `^'.
-Do not use `~' in the TO strings.
-They should be ordinary absolute directory names.
+FROM and TO should be equivalent names, which refer to the
+same directory. Do not use `~' in the TO strings;
+they should be ordinary absolute directory names.
Use this feature when you have directories which you normally refer to
via absolute symbolic links. Make TO the name of the link, and FROM
;; The system null device. (Should reference NULL_DEVICE from C.)
(defvar null-device "/dev/null" "The system null device.")
+(declare-function msdos-long-file-names "msdos.c")
+(declare-function w32-long-file-name "w32proc.c")
+(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
+(declare-function dired-unmark "dired" (arg))
+(declare-function dired-do-flagged-delete "dired" (&optional nomessage))
+(declare-function dos-8+3-filename "dos-fns" (filename))
+(declare-function vms-read-directory "vms-patch" (dirname switches buffer))
+(declare-function view-mode-disable "view" ())
+
(defvar file-name-invalid-regexp
(cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
(concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
(defcustom enable-local-variables t
"Control use of local variables in files you visit.
-The value can be t, nil, :safe, or something else.
+The value can be t, nil, :safe, :all, or something else.
A value of t means file local variables specifications are obeyed
if all the specified variable values are safe; if any values are
:group 'view)
(defvar file-name-history nil
- "History list of file names entered in the minibuffer.")
+ "History list of file names entered in the minibuffer.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
\f
(put 'ange-ftp-completion-hook-function 'safe-magic t)
(defun ange-ftp-completion-hook-function (op &rest args)
(start 0))
;; Replace invalid filename characters with !
(while (string-match "[?*:<>|\"\000-\037]" name start)
- (aset name (match-beginning 0) ?!)
+ (aset name (match-beginning 0) ?!)
(setq start (match-end 0)))
name)
filename))
(if (file-exists-p dir)
(error "%s is not a directory" dir)
(error "%s: no such directory" dir))
- (if (file-executable-p dir)
- (setq default-directory dir)
- (error "Cannot cd to %s: Permission denied" dir))))
+ (unless (file-executable-p dir)
+ (error "Cannot cd to %s: Permission denied" dir))
+ (setq default-directory dir)
+ (set (make-local-variable 'list-buffers-directory) dir)))
(defun cd (dir)
"Make DIR become the current buffer's default directory.
(let ((trypath (parse-colon-path (getenv "CDPATH"))))
(setq cd-path (or trypath (list "./")))))
(if (not (catch 'found
- (mapcar
+ (mapc
(function (lambda (x)
(let ((f (expand-file-name (concat x dir))))
(if (file-directory-p f)
((null action) (try-completion string names))
(t (test-completion string names))))))
+(defun locate-dominating-file (file regexp)
+ "Look up the directory hierarchy from FILE for a file matching REGEXP."
+ (while (and file (not (file-directory-p file)))
+ (setq file (file-name-directory (directory-file-name file))))
+ (catch 'found
+ (let ((user (nth 2 (file-attributes file)))
+ ;; Abbreviate, so as to stop when we cross ~/.
+ (dir (abbreviate-file-name (file-name-as-directory file)))
+ files)
+ ;; As a heuristic, we stop looking up the hierarchy of directories as
+ ;; soon as we find a directory belonging to another user. This should
+ ;; save us from looking in things like /net and /afs. This assumes
+ ;; that all the files inside a project belong to the same user.
+ (while (and dir (equal user (nth 2 (file-attributes dir))))
+ (if (setq files (directory-files dir 'full regexp))
+ (throw 'found (car files))
+ (if (equal dir
+ (setq dir (file-name-directory
+ (directory-file-name dir))))
+ (setq dir nil))))
+ nil)))
+
(defun executable-find (command)
"Search for COMMAND in `exec-path' and return the absolute file name.
Return nil if COMMAND is not found anywhere in `exec-path'."
(cons load-path (get-load-suffixes)))))
(load library))
-(defun file-remote-p (file)
+(defun file-remote-p (file &optional identification connected)
"Test whether FILE specifies a location on a remote system.
-Return an identification of the system if the location is indeed
-remote. The identification of the system may comprise a method
-to access the system and its hostname, amongst other things.
-
-For example, the filename \"/user@host:/foo\" specifies a location
-on the system \"/user@host:\"."
+Returns nil or a string identifying the remote connection (ideally
+a prefix of FILE). For example, the remote identification for filename
+\"/user@host:/foo\" could be \"/user@host:\".
+A file is considered \"remote\" if accessing it is likely to be slower or
+less reliable than accessing local files.
+Furthermore, relative file names do not work across remote connections.
+
+IDENTIFICATION specifies which part of the identification shall
+be returned as string. IDENTIFICATION can be the symbol
+`method', `user' or `host'; any other value is handled like nil
+and means to return the complete identification string.
+
+If CONNECTED is non-nil, the function returns an identification only
+if FILE is located on a remote system, and a connection is established
+to that remote system.
+
+`file-remote-p' will never open a connection on its own."
(let ((handler (find-file-name-handler file 'file-remote-p)))
(if handler
- (funcall handler 'file-remote-p file)
+ (funcall handler 'file-remote-p file identification connected)
nil)))
(defun file-local-copy (file)
"Switch to buffer BUFFER in another frame.
Optional second arg NORECORD non-nil means
do not put this buffer at the front of the list of recently selected ones.
+This function returns the buffer it switched to.
This uses the function `display-buffer' as a subroutine; see its
documentation for additional customization information."
(interactive "BSwitch to buffer in other frame: ")
(let ((pop-up-frames t)
same-window-buffer-names same-window-regexps)
- (pop-to-buffer buffer t norecord)
- (raise-frame (window-frame (selected-window)))))
+ (prog1
+ (pop-to-buffer buffer t norecord)
+ (raise-frame (window-frame (selected-window))))))
(defun display-buffer-other-frame (buffer)
"Switch to buffer BUFFER in another frame.
,@body)
(remove-hook 'minibuffer-setup-hook ,hook)))))
+(defcustom find-file-confirm-nonexistent-file nil
+ "If non-nil, `find-file' requires confirmation before visiting a new file."
+ :group 'find-file
+ :version "23.1"
+ :type 'boolean)
+
(defun find-file-read-args (prompt mustmatch)
(list (let ((find-file-default
(and buffer-file-name
but the visited file name is available through the minibuffer history:
type M-n to pull it into the minibuffer.
+You can visit files on remote machines by specifying something
+like /ssh:SOME_REMOTE_MACHINE:FILE for the file name. You can
+also visit local files as a different user by specifying
+/sudo::FILE for the file name.
+See the Info node `(tramp)Filename Syntax' in the Tramp Info
+manual, for more about this.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files. You can
suppress wildcard expansion by setting `find-file-wildcards' to nil.
To visit a file without any kind of conversion and without
automatically choosing a major mode, use \\[find-file-literally]."
- (interactive (find-file-read-args "Find file: " nil))
+ (interactive
+ (find-file-read-args "Find file: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(mapcar 'switch-to-buffer (nreverse value))
(defun find-file-other-window (filename &optional wildcards)
"Edit file FILENAME, in another window.
-May create a new window, or reuse an existing one.
-See the function `display-buffer'.
+
+Like \\[find-file] (which see), but creates a new window or reuses
+an existing one. See the function `display-buffer'.
Interactively, the default if you just type RET is the current directory,
but the visited file name is available through the minibuffer history:
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive (find-file-read-args "Find file in other window: " nil))
+ (interactive
+ (find-file-read-args "Find file in other window: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
(defun find-file-other-frame (filename &optional wildcards)
"Edit file FILENAME, in another frame.
-May create a new frame, or reuse an existing one.
-See the function `display-buffer'.
+
+Like \\[find-file] (which see), but creates a new frame or reuses
+an existing one. See the function `display-buffer'.
Interactively, the default if you just type RET is the current directory,
but the visited file name is available through the minibuffer history:
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive (find-file-read-args "Find file in other frame: " nil))
+ (interactive
+ (find-file-read-args "Find file in other frame: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
(defun find-file-existing (filename)
"Edit the existing file FILENAME.
-Like \\[find-file] but only allow a file that exists, and do not allow
+Like \\[find-file], but only allow a file that exists, and do not allow
file names with wildcards."
(interactive (nbutlast (find-file-read-args "Find existing file: " t)))
(if (and (not (interactive-p)) (not (file-exists-p filename)))
(defun find-file-read-only (filename &optional wildcards)
"Edit file FILENAME but don't allow changes.
-Like \\[find-file] but marks buffer as read-only.
+Like \\[find-file], but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive (find-file-read-args "Find file read-only: " nil))
+ (interactive
+ (find-file-read-args "Find file read-only: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
(defun find-file-read-only-other-window (filename &optional wildcards)
"Edit file FILENAME in another window but don't allow changes.
-Like \\[find-file-other-window] but marks buffer as read-only.
+Like \\[find-file-other-window], but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive (find-file-read-args "Find file read-only other window: " nil))
+ (interactive
+ (find-file-read-args "Find file read-only other window: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
(defun find-file-read-only-other-frame (filename &optional wildcards)
"Edit file FILENAME in another frame but don't allow changes.
-Like \\[find-file-other-frame] but marks buffer as read-only.
+Like \\[find-file-other-frame], but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive (find-file-read-args "Find file read-only other frame: " nil))
+ (interactive
+ (find-file-read-args "Find file read-only other frame: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
"Find file FILENAME as a replacement for the file in the next window.
This command does not select that window.
+See \\[find-file] for the possible forms of the FILENAME argument.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and replace the file with multiple files."
(interactive
If the current buffer now contains an empty file that you just visited
\(presumably by mistake), use this command to visit the file you really want.
+See \\[find-file] for the possible forms of the FILENAME argument.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and replace the file with multiple files.
(defun create-file-buffer (filename)
"Create a suitably named buffer for visiting FILENAME, and return it.
FILENAME (sans directory) is used unchanged if that name is free;
-otherwise a string <2> or <3> or ... is appended to get an unused name."
+otherwise a string <2> or <3> or ... is appended to get an unused name.
+Spaces at the start of FILENAME (sans directory) are removed."
(let ((lastname (file-name-nondirectory filename)))
(if (string= lastname "")
(setq lastname filename))
- (generate-new-buffer lastname)))
+ (save-match-data
+ (string-match "^ *\\(.*\\)" lastname)
+ (generate-new-buffer (match-string 1 lastname)))))
(defun generate-new-buffer (name)
"Create and return a buffer with a name based on NAME.
("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
("\\.ltx\\'" . latex-mode)
("\\.dtx\\'" . doctex-mode)
+ ("\\.org\\'" . org-mode)
("\\.el\\'" . emacs-lisp-mode)
("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.tar\\'" . tar-mode)
;; The list of archive file extensions should be in sync with
;; `auto-coding-alist' with `no-conversion' coding system.
- ("\\.\\(arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\)\\'" . archive-mode)
- ("\\.\\(ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . archive-mode)
+ ("\\.\\(\
+arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|\
+ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode)
("\\.\\(sx[dmicw]\\|odt\\)\\'" . archive-mode) ; OpenOffice.org
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
("\\.js\\'" . java-mode) ; javascript-mode would be better
- ("\\.x[bp]m\\'" . c-mode)
+ ("\\.d?v\\'" . verilog-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG
("\\.[eE]?[pP][sS]\\'" . ps-mode)
+ ("\\.\\(?:PDF\\|DVI\\|pdf\\|dvi\\)\\'" . doc-view-mode)
("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
("BROWSE\\'" . ebrowse-tree-mode)
("\\.ebrowse\\'" . ebrowse-tree-mode)
("java.+\\.conf\\'" . conf-javaprop-mode)
("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
- ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode)
+ ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe)
("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
;; ChangeLog.old etc. Other change-log-mode entries are above;
based on the interpreters they specify to run,
and `magic-mode-alist', which determines modes based on file contents.")
+(defun conf-mode-maybe ()
+ "Select Conf mode or XML mode according to start of file."
+ (if (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (looking-at "<\\?xml \\|<!-- \\|<!DOCTYPE ")))
+ (xml-mode)
+ (conf-mode)))
+
(defvar interpreter-mode-alist
;; Note: The entries for the modes defined in cc-mode.el (awk-mode
;; and pike-mode) are added through autoload directives in that
;; put them in the first line of
;; such a file without screwing up
;; the interpreter invocation.
- (and (looking-at "^#!") 2)) t)
+ ;; The same holds for
+ ;; '\"
+ ;; in man pages (preprocessor
+ ;; magic for the `man' program).
+ (and (looking-at "^\\(#!\\|'\\\\\"\\)") 2)) t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
:group 'find-file
:type 'alist)
-(defcustom safe-local-eval-forms nil
+(defcustom safe-local-eval-forms '((add-hook 'write-file-hooks 'time-stamp))
"Expressions that are considered safe in an `eval:' local variable.
Add expressions to this list if you want Emacs to evaluate them, when
they appear in an `eval' local variable specification, without first
asking you for confirmation."
:group 'find-file
- :version "22.1"
+ :version "22.2"
:type '(repeat sexp))
;; Risky local variables:
minor-mode-overriding-map-alist
mode-line-buffer-identification
mode-line-format
+ mode-line-client
mode-line-modes
mode-line-modified
mode-line-mule-info
mode-line-position
mode-line-process
+ mode-line-remote
mode-name
outline-level
overriding-local-map
(if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g)))
done)
(while (not done)
- (message prompt)
+ (message "%s" prompt)
(setq char (read-event))
(if (numberp char)
(cond ((eq char ?\C-v)
(dolist (elt result)
(let ((var (car elt))
(val (cdr elt)))
- (or (eq var 'mode)
+ ;; Don't query about the fake variables.
+ (or (memq var '(mode unibyte coding))
(and (eq var 'eval)
(or (eq enable-local-eval t)
(hack-one-local-variable-eval-safep
;; If caller wants only the safe variables,
;; install only them.
(dolist (elt result)
- (unless (or (memq (car elt) unsafe-vars)
- (memq (car elt) risky-vars))
+ (unless (or (member elt unsafe-vars)
+ (member elt risky-vars))
(hack-one-local-variable (car elt) (cdr elt))))
;; Query, except in the case where all are known safe
;; if the user wants no quuery in that case.
(set-default-file-modes ?\700)
(when (condition-case nil
;; Try to overwrite old backup first.
- (copy-file from-name to-name t t)
+ (copy-file from-name to-name t t t)
(error t))
(while (condition-case nil
(progn
(when (file-exists-p to-name)
(delete-file to-name))
- (copy-file from-name to-name nil t)
+ (copy-file from-name to-name nil t t)
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
(length name))
(if keep-backup-version
(length name)
- (or (string-match "\\.~[0-9.]+~\\'" name)
+ (or (string-match "\\.~[-[:alnum:]:#@^._]+~\\'" name)
(string-match "~\\'" name)
(length name))))))))
(defun make-directory (dir &optional parents)
"Create the directory DIR and any nonexistent parent dirs.
+If DIR already exists as a directory, do nothing.
+
Interactively, the default choice of directory to create
is the current default directory for file names.
That is useful when you have visited a file in a nonexistent directory.
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
-This command also works for special buffers that contain text which
-doesn't come from a file, but reflects some other data base instead:
-for example, Dired buffers and `buffer-list' buffers. In these cases,
-it reconstructs the buffer contents from the appropriate data base.
+This command also implements an interface for special buffers
+that contain text which doesn't come from a file, but reflects
+some other data instead (e.g. Dired buffers, `buffer-list'
+buffers). This is done via the variable
+`revert-buffer-function'. In these cases, it should reconstruct
+the buffer contents from the appropriate data.
When called from Lisp, the first argument is IGNORE-AUTO; only offer
to revert from the auto-save file when this is nil. Note that the
(message "No files can be recovered from this session now")))
(kill-buffer buffer))))
+(defun kill-buffer-ask (buffer)
+ "Kill buffer if confirmed."
+ (when (yes-or-no-p
+ (format "Buffer %s %s. Kill? " (buffer-name buffer)
+ (if (buffer-modified-p buffer)
+ "HAS BEEN EDITED" "is unmodified")))
+ (kill-buffer buffer)))
+
(defun kill-some-buffers (&optional list)
"Kill some buffers. Asks the user whether to kill each one of them.
Non-interactively, if optional argument LIST is non-nil, it
; if we killed the base buffer.
(not (string-equal name ""))
(/= (aref name 0) ?\s)
- (yes-or-no-p
- (format "Buffer %s %s. Kill? "
- name
- (if (buffer-modified-p buffer)
- "HAS BEEN EDITED" "is unmodified")))
- (kill-buffer buffer)))
+ (kill-buffer-ask buffer)))
(setq list (cdr list))))
+
+(defun kill-matching-buffers (regexp &optional internal-too)
+ "Kill buffers whose name matches the specified regexp.
+The optional second argument indicates whether to kill internal buffers too."
+ (interactive "sKill buffers matching this regular expression: \nP")
+ (dolist (buffer (buffer-list))
+ (let ((name (buffer-name buffer)))
+ (when (and name (not (string-equal name ""))
+ (or internal-too (/= (aref name 0) ?\s))
+ (string-match regexp name))
+ (kill-buffer-ask buffer)))))
+
\f
(defun auto-save-mode (arg)
"Toggle auto-saving of contents of current buffer.
(defvar kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
If any of these functions returns nil, killing Emacs is cancelled.
-`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
-but `kill-emacs', the low level primitive, does not.
-See also `kill-emacs-hook'.")
+`save-buffers-kill-emacs' calls these functions, but `kill-emacs',
+the low level primitive, does not. See also `kill-emacs-hook'.")
(defcustom confirm-kill-emacs nil
"How to ask for confirmation when leaving Emacs.
(or (null confirm-kill-emacs)
(funcall confirm-kill-emacs "Really exit Emacs? "))
(kill-emacs)))
+
+(defun save-buffers-kill-terminal (&optional arg)
+ "Offer to save each buffer, then kill the current connection.
+If the current frame has no client, kill Emacs itself.
+
+With prefix arg, silently save all file-visiting buffers, then kill.
+
+If emacsclient was started with a list of filenames to edit, then
+only these files will be asked to be saved."
+ (interactive "P")
+ (let ((proc (frame-parameter (selected-frame) 'client))
+ (frame (selected-frame)))
+ (if (null proc)
+ (save-buffers-kill-emacs)
+ (server-save-buffers-kill-terminal proc arg))))
+
\f
;; We use /: as a prefix to "quote" a file name
;; so that magic file name handlers will not apply to it.
(t
(apply operation arguments)))))
\f
+;; Symbolic modes and read-file-modes.
+
+(defun file-modes-char-to-who (char)
+ "Convert CHAR to a who-mask from a symbolic mode notation.
+CHAR is in [ugoa] and represents the users on which rights are applied."
+ (cond ((= char ?u) #o4700)
+ ((= char ?g) #o2070)
+ ((= char ?o) #o1007)
+ ((= char ?a) #o7777)
+ (t (error "%c: bad `who' character" char))))
+
+(defun file-modes-char-to-right (char &optional from)
+ "Convert CHAR to a right-mask from a symbolic mode notation.
+CHAR is in [rwxXstugo] and represents a right.
+If CHAR is in [Xugo], the value is extracted from FROM (or 0 if nil)."
+ (or from (setq from 0))
+ (cond ((= char ?r) #o0444)
+ ((= char ?w) #o0222)
+ ((= char ?x) #o0111)
+ ((= char ?s) #o1000)
+ ((= char ?t) #o6000)
+ ;; Rights relative to the previous file modes.
+ ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
+ ((= char ?u) (let ((uright (logand #o4700 from)))
+ (+ uright (/ uright #o10) (/ uright #o100))))
+ ((= char ?g) (let ((gright (logand #o2070 from)))
+ (+ gright (/ gright #o10) (* gright #o10))))
+ ((= char ?o) (let ((oright (logand #o1007 from)))
+ (+ oright (* oright #o10) (* oright #o100))))
+ (t (error "%c: bad right character" char))))
+
+(defun file-modes-rights-to-number (rights who-mask &optional from)
+ "Convert a right string to a right-mask from a symbolic modes notation.
+RIGHTS is the right string, it should match \"([+=-][rwxXstugo]+)+\".
+WHO-MASK is the mask number of the users on which the rights are to be applied.
+FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+ (let* ((num-rights (or from 0))
+ (list-rights (string-to-list rights))
+ (op (pop list-rights)))
+ (while (memq op '(?+ ?- ?=))
+ (let ((num-right 0)
+ char-right)
+ (while (memq (setq char-right (pop list-rights))
+ '(?r ?w ?x ?X ?s ?t ?u ?g ?o))
+ (setq num-right
+ (logior num-right
+ (file-modes-char-to-right char-right num-rights))))
+ (setq num-right (logand who-mask num-right)
+ num-rights
+ (cond ((= op ?+) (logior num-rights num-right))
+ ((= op ?-) (logand num-rights (lognot num-right)))
+ (t (logior (logand num-rights (lognot who-mask)) num-right)))
+ op char-right)))
+ num-rights))
+
+(defun file-modes-symbolic-to-number (modes &optional from)
+ "Convert symbolic file modes to numeric file modes.
+MODES is the string to convert, it should match
+\"[ugoa]*([+-=][rwxXstugo]+)+,...\".
+See (info \"(coreutils)File permissions\") for more information on this
+notation.
+FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+ (save-match-data
+ (let ((case-fold-search nil)
+ (num-modes (or from 0)))
+ (while (/= (string-to-char modes) 0)
+ (if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]+\\)+\\(,\\|\\)" modes)
+ (let ((num-who (apply 'logior 0
+ (mapcar 'file-modes-char-to-who
+ (match-string 1 modes)))))
+ (when (= num-who 0)
+ (setq num-who (default-file-modes)))
+ (setq num-modes
+ (file-modes-rights-to-number (substring modes (match-end 1))
+ num-who num-modes)
+ modes (substring modes (match-end 3))))
+ (error "Parse error in modes near `%s'" (substring modes 0))))
+ num-modes)))
+
+(defun read-file-modes (&optional prompt orig-file)
+ "Read file modes in octal or symbolic notation.
+PROMPT is used as the prompt, default to `File modes (octal or symbolic): '.
+ORIG-FILE is the original file of which modes will be change."
+ (let* ((modes (or (if orig-file (file-modes orig-file) 0)
+ (error "File not found")))
+ (value (read-string (or prompt "File modes (octal or symbolic): "))))
+ (save-match-data
+ (if (string-match "^[0-7]+" value)
+ (string-to-number value 8)
+ (file-modes-symbolic-to-number value modes)))))
+
+\f
(define-key ctl-x-map "\C-f" 'find-file)
(define-key ctl-x-map "\C-r" 'find-file-read-only)
(define-key ctl-x-map "\C-v" 'find-alternate-file)
(define-key ctl-x-map "i" 'insert-file)
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
-(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
+(define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal)
(define-key ctl-x-map "\C-q" 'toggle-read-only)
(define-key ctl-x-4-map "f" 'find-file-other-window)
HCoop / bpt / emacs.git / blobdiff