~ubuntu-branches/ubuntu/karmic/emacs-snapshot/karmic

« back to all changes in this revision

Viewing changes to lisp/files.el

  • Committer: Bazaar Package Importer
  • Author(s): Reinhard Tartler
  • Date: 2009-04-05 09:14:30 UTC
  • mto: This revision was merged to the branch mainline in revision 34.
  • Revision ID: james.westby@ubuntu.com-20090405091430-nw07lynn2arotjbe
Tags: upstream-20090320
ImportĀ upstreamĀ versionĀ 20090320

Show diffs side-by-side

added added

removed removed

Lines of Context:
2
2
 
3
3
;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996,
4
4
;;   1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5
 
;;   2006, 2007, 2008 Free Software Foundation, Inc.
 
5
;;   2006, 2007, 2008, 2009 Free Software Foundation, Inc.
6
6
 
7
7
;; Maintainer: FSF
8
8
 
154
154
  :group 'find-file)
155
155
 
156
156
(defcustom find-file-visit-truename nil
157
 
  "*Non-nil means visit a file under its truename.
 
157
  "Non-nil means visit a file under its truename.
158
158
The truename of a file is found by chasing all links
159
159
both at the file level and at the levels of the containing directories."
160
160
  :type 'boolean
214
214
(declare-function dired-do-flagged-delete "dired" (&optional nomessage))
215
215
(declare-function dos-8+3-filename "dos-fns" (filename))
216
216
(declare-function view-mode-disable "view" ())
 
217
(declare-function dosified-file-name "dos-fns" (file-name))
217
218
 
218
219
(defvar file-name-invalid-regexp
219
220
  (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
239
240
 
240
241
Note that this feature forces backups to be made by copying.
241
242
Yet, at the same time, saving a precious file
242
 
breaks any hard links between it and other files."
 
243
breaks any hard links between it and other files.
 
244
 
 
245
This feature is advisory: for example, if the directory in which the
 
246
file is being saved is not writable, Emacs may ignore a non-nil value
 
247
of `file-precious-flag' and write directly into the file.
 
248
 
 
249
See also: `break-hardlink-on-save'."
243
250
  :type 'boolean
244
251
  :group 'backup)
245
252
 
 
253
(defcustom break-hardlink-on-save nil
 
254
  "Non-nil means when saving a file that exists under several names
 
255
\(i.e., has multiple hardlinks), break the hardlink associated with
 
256
`buffer-file-name' and write to a new file, so that the other
 
257
instances of the file are not affected by the save.
 
258
 
 
259
If `buffer-file-name' refers to a symlink, do not break the symlink.
 
260
 
 
261
Unlike `file-precious-flag', `break-hardlink-on-save' is not advisory.
 
262
For example, if the directory in which a file is being saved is not
 
263
itself writable, then error instead of saving in some
 
264
hardlink-nonbreaking way.
 
265
 
 
266
See also `backup-by-copying' and `backup-by-copying-when-linked'."
 
267
  :type 'boolean
 
268
  :group 'files
 
269
  :version "23.1")
 
270
 
246
271
(defcustom version-control nil
247
272
  "Control use of version numbers for backup files.
248
273
When t, make numeric backup versions unconditionally.
487
512
(defcustom enable-local-eval 'maybe
488
513
  "Control processing of the \"variable\" `eval' in a file's local variables.
489
514
The value can be t, nil or something else.
490
 
A value of t means obey `eval' variables;
 
515
A value of t means obey `eval' variables.
491
516
A value of nil means ignore them; anything else means query."
492
517
  :type '(choice (const :tag "Obey" t)
493
518
                 (const :tag "Ignore" nil)
716
741
                                string nil action))
717
742
(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1")
718
743
 
719
 
(defun locate-dominating-file (file regexp)
720
 
  "Look up the directory hierarchy from FILE for a file matching REGEXP."
721
 
  (catch 'found
722
 
    ;; `user' is not initialized yet because `file' may not exist, so we may
723
 
    ;; have to walk up part of the hierarchy before we find the "initial UID".
724
 
    (let ((user nil)
725
 
          ;; Abbreviate, so as to stop when we cross ~/.
726
 
          (dir (abbreviate-file-name (file-name-as-directory file)))
727
 
          files)
728
 
      (while (and dir
729
 
                  ;; As a heuristic, we stop looking up the hierarchy of
730
 
                  ;; directories as soon as we find a directory belonging to
731
 
                  ;; another user.  This should save us from looking in
732
 
                  ;; things like /net and /afs.  This assumes that all the
733
 
                  ;; files inside a project belong to the same user.
734
 
                  (let ((prev-user user))
735
 
                    (setq user (nth 2 (file-attributes dir)))
736
 
                    (or (null prev-user) (equal user prev-user))))
737
 
        (if (setq files (condition-case nil
738
 
                            (directory-files dir 'full regexp)
739
 
                          (error nil)))
740
 
            (throw 'found (car files))
741
 
          (if (equal dir
742
 
                     (setq dir (file-name-directory
743
 
                                (directory-file-name dir))))
744
 
              (setq dir nil))))
745
 
      nil)))
 
744
(defvar locate-dominating-stop-dir-regexp
 
745
  "\\`\\(?:[\\/][\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'"
 
746
  "Regexp of directory names which stop the search in `locate-dominating-file'.
 
747
Any directory whose name matches this regexp will be treated like
 
748
a kind of root directory by `locate-dominating-file' which will stop its search
 
749
when it bumps into it.
 
750
The default regexp prevents fruitless and time-consuming attempts to find
 
751
special files in directories in which filenames are interpreted as hostnames.")
 
752
 
 
753
;; (defun locate-dominating-files (file regexp)
 
754
;;   "Look up the directory hierarchy from FILE for a file matching REGEXP.
 
755
;; Stop at the first parent where a matching file is found and return the list
 
756
;; of files that that match in this directory."
 
757
;;   (catch 'found
 
758
;;     ;; `user' is not initialized yet because `file' may not exist, so we may
 
759
;;     ;; have to walk up part of the hierarchy before we find the "initial UID".
 
760
;;     (let ((user nil)
 
761
;;           ;; Abbreviate, so as to stop when we cross ~/.
 
762
;;           (dir (abbreviate-file-name (file-name-as-directory file)))
 
763
;;           files)
 
764
;;       (while (and dir
 
765
;;                   ;; As a heuristic, we stop looking up the hierarchy of
 
766
;;                   ;; directories as soon as we find a directory belonging to
 
767
;;                   ;; another user.  This should save us from looking in
 
768
;;                   ;; things like /net and /afs.  This assumes that all the
 
769
;;                   ;; files inside a project belong to the same user.
 
770
;;                   (let ((prev-user user))
 
771
;;                     (setq user (nth 2 (file-attributes dir)))
 
772
;;                     (or (null prev-user) (equal user prev-user))))
 
773
;;         (if (setq files (condition-case nil
 
774
;;                          (directory-files dir 'full regexp 'nosort)
 
775
;;                        (error nil)))
 
776
;;             (throw 'found files)
 
777
;;           (if (equal dir
 
778
;;                      (setq dir (file-name-directory
 
779
;;                                 (directory-file-name dir))))
 
780
;;               (setq dir nil))))
 
781
;;       nil)))
 
782
 
 
783
(defun locate-dominating-file (file name)
 
784
  "Look up the directory hierarchy from FILE for a file named NAME.
 
785
Stop at the first parent directory containing a file NAME,
 
786
and return the directory.  Return nil if not found."
 
787
  ;; We used to use the above locate-dominating-files code, but the
 
788
  ;; directory-files call is very costly, so we're much better off doing
 
789
  ;; multiple calls using the code in here.
 
790
  ;;
 
791
  ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
 
792
  ;; `name' in /home or in /.
 
793
  (setq file (abbreviate-file-name file))
 
794
  (let ((root nil)
 
795
        (prev-file file)
 
796
        ;; `user' is not initialized outside the loop because
 
797
        ;; `file' may not exist, so we may have to walk up part of the
 
798
        ;; hierarchy before we find the "initial UID".
 
799
        (user nil)
 
800
        try)
 
801
    (while (not (or root
 
802
                    (null file)
 
803
                    ;; FIXME: Disabled this heuristic because it is sometimes
 
804
                    ;; inappropriate.
 
805
                    ;; As a heuristic, we stop looking up the hierarchy of
 
806
                    ;; directories as soon as we find a directory belonging
 
807
                    ;; to another user.  This should save us from looking in
 
808
                    ;; things like /net and /afs.  This assumes that all the
 
809
                    ;; files inside a project belong to the same user.
 
810
                    ;; (let ((prev-user user))
 
811
                    ;;   (setq user (nth 2 (file-attributes file)))
 
812
                    ;;   (and prev-user (not (equal user prev-user))))
 
813
                    (string-match locate-dominating-stop-dir-regexp file)))
 
814
      (setq try (file-exists-p (expand-file-name name file)))
 
815
      (cond (try (setq root file))
 
816
            ((equal file (setq prev-file file
 
817
                               file (file-name-directory
 
818
                                     (directory-file-name file))))
 
819
             (setq file nil))))
 
820
    root))
 
821
 
746
822
 
747
823
(defun executable-find (command)
748
824
  "Search for COMMAND in `exec-path' and return the absolute file name.
753
829
 
754
830
(defun load-library (library)
755
831
  "Load the library named LIBRARY.
 
832
 
 
833
LIBRARY should be a relative file name of the library, a string.
 
834
It can omit the suffix (a.k.a. file-name extension).
 
835
 
756
836
This is an interface to the function `load'."
757
837
  (interactive
758
838
   (list (completing-read "Load library: "
1047
1127
    (rename-file encoded new-encoded ok-if-already-exists)
1048
1128
    newname))
1049
1129
 
 
1130
(defcustom confirm-nonexistent-file-or-buffer 'after-completion
 
1131
  "Whether confirmation is requested before visiting a new file or buffer.
 
1132
If nil, confirmation is not requested.
 
1133
If the value is `after-completion', confirmation is only
 
1134
 requested if the user called `minibuffer-complete' right before
 
1135
 `minibuffer-complete-and-exit'.
 
1136
Any other non-nil value means to request confirmation.
 
1137
 
 
1138
This affects commands like `switch-to-buffer' and `find-file'."
 
1139
  :group 'find-file
 
1140
  :version "23.1"
 
1141
  :type '(choice (const :tag "After completion" after-completion)
 
1142
                 (const :tag "Never" nil)
 
1143
                 (other :tag "Always" t)))
 
1144
 
 
1145
(defun confirm-nonexistent-file-or-buffer ()
 
1146
  "Whether to request confirmation before visiting a new file or buffer.
 
1147
The variable `confirm-nonexistent-file-or-buffer' determines the
 
1148
return value, which may be passed as the REQUIRE-MATCH arg to
 
1149
`read-buffer' or `find-file-read-args'."
 
1150
  (cond ((eq confirm-nonexistent-file-or-buffer 'after-completion)
 
1151
         'confirm-after-completion)
 
1152
        (confirm-nonexistent-file-or-buffer
 
1153
         'confirm)
 
1154
        (t nil)))
 
1155
 
1050
1156
(defun read-buffer-to-switch (prompt)
1051
1157
  "Read the name of a buffer to switch to and return as a string.
1052
1158
It is intended for `switch-to-buffer' family of commands since they
1054
1160
and default values."
1055
1161
  (let ((rbts-completion-table (internal-complete-buffer-except)))
1056
1162
    (minibuffer-with-setup-hook
1057
 
        (lambda () (setq minibuffer-completion-table rbts-completion-table))
1058
 
      (read-buffer prompt (other-buffer (current-buffer))))))
1059
 
 
1060
 
(defun switch-to-buffer-other-window (buffer &optional norecord)
1061
 
  "Select buffer BUFFER in another window.
1062
 
If BUFFER does not identify an existing buffer, then this function
1063
 
creates a buffer with that name.
1064
 
 
1065
 
When called from Lisp, BUFFER can be a buffer, a string \(a buffer name),
1066
 
or nil.  If BUFFER is nil, then this function chooses a buffer
1067
 
using `other-buffer'.
1068
 
Optional second arg NORECORD non-nil means
1069
 
do not put this buffer at the front of the list of recently selected ones.
1070
 
This function returns the buffer it switched to.
 
1163
        (lambda ()
 
1164
          (setq minibuffer-completion-table rbts-completion-table)
 
1165
          ;; Since rbts-completion-table is built dynamically, we
 
1166
          ;; can't just add it to the default value of
 
1167
          ;; icomplete-with-completion-tables, so we add it
 
1168
          ;; here manually.
 
1169
          (if (and (boundp 'icomplete-with-completion-tables)
 
1170
                   (listp icomplete-with-completion-tables))
 
1171
              (set (make-local-variable 'icomplete-with-completion-tables)
 
1172
                   (cons rbts-completion-table
 
1173
                         icomplete-with-completion-tables))))
 
1174
      (read-buffer prompt (other-buffer (current-buffer))
 
1175
                   (confirm-nonexistent-file-or-buffer)))))
 
1176
 
 
1177
(defun switch-to-buffer-other-window (buffer-or-name &optional norecord)
 
1178
  "Select the buffer specified by BUFFER-OR-NAME in another window.
 
1179
BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
 
1180
nil.  Return the buffer switched to.
 
1181
 
 
1182
If called interactively, prompt for the buffer name using the
 
1183
minibuffer.  The variable `confirm-nonexistent-file-or-buffer'
 
1184
determines whether to request confirmation before creating a new
 
1185
buffer.
 
1186
 
 
1187
If BUFFER-OR-NAME is a string and does not identify an existing
 
1188
buffer, create a new buffer with that name.  If BUFFER-OR-NAME is
 
1189
nil, switch to the buffer returned by `other-buffer'.
 
1190
 
 
1191
Optional second argument NORECORD non-nil means do not put this
 
1192
buffer at the front of the list of recently selected ones.
1071
1193
 
1072
1194
This uses the function `display-buffer' as a subroutine; see its
1073
1195
documentation for additional customization information."
1074
1196
  (interactive
1075
1197
   (list (read-buffer-to-switch "Switch to buffer in other window: ")))
1076
1198
  (let ((pop-up-windows t)
1077
 
        ;; Don't let these interfere.
1078
1199
        same-window-buffer-names same-window-regexps)
1079
 
    (pop-to-buffer buffer t norecord)))
1080
 
 
1081
 
(defun switch-to-buffer-other-frame (buffer &optional norecord)
1082
 
  "Switch to buffer BUFFER in another frame.
 
1200
    (pop-to-buffer buffer-or-name t norecord)))
 
1201
 
 
1202
(defun switch-to-buffer-other-frame (buffer-or-name &optional norecord)
 
1203
  "Switch to buffer BUFFER-OR-NAME in another frame.
 
1204
BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
 
1205
nil.  Return the buffer switched to.
 
1206
 
 
1207
If called interactively, prompt for the buffer name using the
 
1208
minibuffer.  The variable `confirm-nonexistent-file-or-buffer'
 
1209
determines whether to request confirmation before creating a new
 
1210
buffer.
 
1211
 
 
1212
If BUFFER-OR-NAME is a string and does not identify an existing
 
1213
buffer, create a new buffer with that name.  If BUFFER-OR-NAME is
 
1214
nil, switch to the buffer returned by `other-buffer'.
 
1215
 
1083
1216
Optional second arg NORECORD non-nil means do not put this
1084
1217
buffer at the front of the list of recently selected ones.
1085
 
This function returns the buffer it switched to.
1086
1218
 
1087
 
This uses the function `display-buffer' as a subroutine; see
1088
 
its documentation for additional customization information."
 
1219
This uses the function `display-buffer' as a subroutine; see its
 
1220
documentation for additional customization information."
1089
1221
  (interactive
1090
1222
   (list (read-buffer-to-switch "Switch to buffer in other frame: ")))
1091
1223
  (let ((pop-up-frames t)
1092
1224
        same-window-buffer-names same-window-regexps)
1093
 
    (pop-to-buffer buffer t norecord)))
 
1225
    (pop-to-buffer buffer-or-name t norecord)))
1094
1226
 
1095
1227
(defun display-buffer-other-frame (buffer)
1096
1228
  "Display buffer BUFFER in another frame.
1137
1269
             ,@body)
1138
1270
         (remove-hook 'minibuffer-setup-hook ,hook)))))
1139
1271
 
1140
 
(defcustom find-file-confirm-nonexistent-file nil
1141
 
  "If non-nil, `find-file' requires confirmation before visiting a new file."
1142
 
  :group 'find-file
1143
 
  :version "23.1"
1144
 
  :type 'boolean)
1145
 
 
1146
1272
(defun find-file-read-args (prompt mustmatch)
1147
1273
  (list (let ((find-file-default
1148
1274
               (and buffer-file-name
1175
1301
automatically choosing a major mode, use \\[find-file-literally]."
1176
1302
  (interactive
1177
1303
   (find-file-read-args "Find file: "
1178
 
                        (if find-file-confirm-nonexistent-file 'confirm-only)))
 
1304
                        (confirm-nonexistent-file-or-buffer)))
1179
1305
  (let ((value (find-file-noselect filename nil nil wildcards)))
1180
1306
    (if (listp value)
1181
1307
        (mapcar 'switch-to-buffer (nreverse value))
1195
1321
expand wildcards (if any) and visit multiple files."
1196
1322
  (interactive
1197
1323
   (find-file-read-args "Find file in other window: "
1198
 
                        (if find-file-confirm-nonexistent-file 'confirm-only)))
 
1324
                        (confirm-nonexistent-file-or-buffer)))
1199
1325
  (let ((value (find-file-noselect filename nil nil wildcards)))
1200
1326
    (if (listp value)
1201
1327
        (progn
1218
1344
expand wildcards (if any) and visit multiple files."
1219
1345
  (interactive
1220
1346
   (find-file-read-args "Find file in other frame: "
1221
 
                        (if find-file-confirm-nonexistent-file 'confirm-only)))
 
1347
                        (confirm-nonexistent-file-or-buffer)))
1222
1348
  (let ((value (find-file-noselect filename nil nil wildcards)))
1223
1349
    (if (listp value)
1224
1350
        (progn
1243
1369
Use \\[toggle-read-only] to permit editing."
1244
1370
  (interactive
1245
1371
   (find-file-read-args "Find file read-only: "
1246
 
                        (if find-file-confirm-nonexistent-file 'confirm-only)))
 
1372
                        (confirm-nonexistent-file-or-buffer)))
1247
1373
  (unless (or (and wildcards find-file-wildcards
1248
1374
                   (not (string-match "\\`/:" filename))
1249
1375
                   (string-match "[[*?]" filename))
1260
1386
Use \\[toggle-read-only] to permit editing."
1261
1387
  (interactive
1262
1388
   (find-file-read-args "Find file read-only other window: "
1263
 
                        (if find-file-confirm-nonexistent-file 'confirm-only)))
 
1389
                        (confirm-nonexistent-file-or-buffer)))
1264
1390
  (unless (or (and wildcards find-file-wildcards
1265
1391
                   (not (string-match "\\`/:" filename))
1266
1392
                   (string-match "[[*?]" filename))
1277
1403
Use \\[toggle-read-only] to permit editing."
1278
1404
  (interactive
1279
1405
   (find-file-read-args "Find file read-only other frame: "
1280
 
                        (if find-file-confirm-nonexistent-file 'confirm-only)))
 
1406
                        (confirm-nonexistent-file-or-buffer)))
1281
1407
  (unless (or (and wildcards find-file-wildcards
1282
1408
                   (not (string-match "\\`/:" filename))
1283
1409
                   (string-match "[[*?]" filename))
2079
2205
     ("\\.\\(\
2080
2206
arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|\
2081
2207
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode)
2082
 
     ("\\.\\(sx[dmicw]\\|odt\\)\\'" . archive-mode)     ; OpenOffice.org
2083
 
     ("\\.\\(deb\\)\\'" . archive-mode)                 ; Debian packages.
 
2208
     ("\\.\\(sx[dmicw]\\|od[fgpst]\\|oxt\\)\\'" . archive-mode) ;OpenOffice.org
 
2209
     ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages.
2084
2210
     ;; Mailer puts message to be edited in
2085
2211
     ;; /tmp/Re.... or Message
2086
2212
     ("\\`/tmp/Re" . text-mode)
2642
2768
This hook is called only if there is at least one file-local
2643
2769
variable to set.")
2644
2770
 
2645
 
(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars project)
 
2771
(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars dir-name)
2646
2772
  "Get confirmation before setting up local variable values.
2647
2773
ALL-VARS is the list of all variables to be set up.
2648
2774
UNSAFE-VARS is the list of those that aren't marked as safe or risky.
2649
2775
RISKY-VARS is the list of those that are marked as risky.
2650
 
PROJECT is a directory name if these settings come from directory-local
2651
 
settings, or nil otherwise."
 
2776
DIR-NAME is a directory name if these settings come from
 
2777
directory-local variables, or nil otherwise."
2652
2778
  (if noninteractive
2653
2779
      nil
2654
 
    (let ((name (if buffer-file-name
2655
 
                    (file-name-nondirectory buffer-file-name)
2656
 
                  (concat "buffer " (buffer-name))))
 
2780
    (let ((name (or dir-name
 
2781
                    (if buffer-file-name
 
2782
                        (file-name-nondirectory buffer-file-name)
 
2783
                      (concat "buffer " (buffer-name)))))
2657
2784
          (offer-save (and (eq enable-local-variables t) unsafe-vars))
2658
2785
          prompt char)
2659
2786
      (save-window-excursion
2662
2789
          (set (make-local-variable 'cursor-type) nil)
2663
2790
          (erase-buffer)
2664
2791
          (if unsafe-vars
2665
 
              (insert "The local variables list in " (or project name)
 
2792
              (insert "The local variables list in " name
2666
2793
                      "\ncontains values that may not be safe (*)"
2667
2794
                      (if risky-vars
2668
2795
                          ", and variables that are risky (**)."
2669
2796
                        "."))
2670
2797
            (if risky-vars
2671
 
                (insert "The local variables list in " (or project name)
 
2798
                (insert "The local variables list in " name
2672
2799
                        "\ncontains variables that are risky (**).")
2673
 
              (insert "A local variables list is specified in "
2674
 
                      (or project name) ".")))
 
2800
              (insert "A local variables list is specified in " name ".")))
2675
2801
          (insert "\n\nDo you want to apply it?  You can type
2676
2802
y  -- to apply the local variables list.
2677
2803
n  -- to ignore the local variables list.")
2793
2919
          mode-specified
2794
2920
        result))))
2795
2921
 
2796
 
(defun hack-local-variables-filter (variables project)
 
2922
(defun hack-local-variables-filter (variables dir-name)
2797
2923
  "Filter local variable settings, querying the user if necessary.
2798
2924
VARIABLES is the alist of variable-value settings.  This alist is
2799
2925
 filtered based on the values of `ignored-local-variables',
2800
2926
 `enable-local-eval', `enable-local-variables', and (if necessary)
2801
2927
 user interaction.  The results are added to
2802
2928
 `file-local-variables-alist', without applying them.
2803
 
PROJECT is a directory name if these settings come from
2804
 
 directory-local settings, or nil otherwise."
 
2929
DIR-NAME is a directory name if these settings come from
 
2930
 directory-local variables, or nil otherwise."
2805
2931
  ;; Strip any variables that are in `ignored-local-variables'.
2806
2932
  (dolist (ignored ignored-local-variables)
2807
2933
    (setq variables (assq-delete-all ignored variables)))
2839
2965
                     (null risky-vars))
2840
2966
                (eq enable-local-variables :all)
2841
2967
                (hack-local-variables-confirm
2842
 
                 variables unsafe-vars risky-vars project))
 
2968
                 variables unsafe-vars risky-vars dir-name))
2843
2969
            (dolist (elt variables)
2844
2970
              (push elt file-local-variables-alist)))))))
2845
2971
 
2852
2978
        result)
2853
2979
    (unless mode-only
2854
2980
      (setq file-local-variables-alist nil)
2855
 
      (report-errors "Project local-variables error: %s"
2856
 
        (hack-project-variables)))
 
2981
      (report-errors "Directory-local variables error: %s"
 
2982
        (hack-dir-local-variables)))
2857
2983
    (when (or mode-only enable-local-variables)
2858
2984
      (setq result (hack-local-variables-prop-line mode-only))
2859
2985
      ;; Look for "Local variables:" line in last page.
3055
3181
             (set-text-properties 0 (length val) nil val))
3056
3182
         (set (make-local-variable var) val))))
3057
3183
 
3058
 
;;; Handling directory local variables, aka project settings.
3059
 
 
3060
 
(defvar project-class-alist '()
3061
 
  "Alist mapping project class names (symbols) to project variable lists.")
3062
 
 
3063
 
(defvar project-directory-alist '()
3064
 
  "Alist mapping project directory roots to project classes.")
3065
 
 
3066
 
(defsubst project-get-alist (class)
3067
 
  "Return the project variable list for project CLASS."
3068
 
  (cdr (assq class project-class-alist)))
3069
 
 
3070
 
(defun project-collect-bindings-from-alist (mode-alist settings)
3071
 
  "Collect local variable settings from MODE-ALIST.
3072
 
SETTINGS is the initial list of bindings.
 
3184
;;; Handling directory-local variables, aka project settings.
 
3185
 
 
3186
(defvar dir-locals-class-alist '()
 
3187
  "Alist mapping class names (symbols) to variable lists.")
 
3188
 
 
3189
(defvar dir-locals-directory-alist '()
 
3190
  "Alist mapping directory roots to variable classes.")
 
3191
 
 
3192
(defsubst dir-locals-get-class-variables (class)
 
3193
  "Return the variable list for CLASS."
 
3194
  (cdr (assq class dir-locals-class-alist)))
 
3195
 
 
3196
(defun dir-locals-collect-mode-variables (mode-variables variables)
 
3197
  "Collect directory-local variables from MODE-VARIABLES.
 
3198
VARIABLES is the initial list of variables.
3073
3199
Returns the new list."
3074
 
  (dolist (pair mode-alist settings)
 
3200
  (dolist (pair mode-variables variables)
3075
3201
    (let* ((variable (car pair))
3076
3202
           (value (cdr pair))
3077
 
           (slot (assq variable settings)))
 
3203
           (slot (assq variable variables)))
3078
3204
      (if slot
3079
3205
          (setcdr slot value)
3080
3206
        ;; Need a new cons in case we setcdr later.
3081
 
        (push (cons variable value) settings)))))
 
3207
        (push (cons variable value) variables)))))
3082
3208
 
3083
 
(defun project-collect-binding-list (binding-list root settings)
3084
 
  "Collect entries from BINDING-LIST into SETTINGS.
 
3209
(defun dir-locals-collect-variables (class-variables root variables)
 
3210
  "Collect entries from CLASS-VARIABLES into VARIABLES.
3085
3211
ROOT is the root directory of the project.
3086
 
Return the new settings list."
 
3212
Return the new variables list."
3087
3213
  (let* ((file-name (buffer-file-name))
3088
3214
         (sub-file-name (if file-name
3089
3215
                            (substring file-name (length root)))))
3090
 
    (dolist (entry binding-list settings)
 
3216
    (dolist (entry class-variables variables)
3091
3217
      (let ((key (car entry)))
3092
3218
        (cond
3093
3219
         ((stringp key)
3096
3222
          (when (and sub-file-name
3097
3223
                     (>= (length sub-file-name) (length key))
3098
3224
                     (string= key (substring sub-file-name 0 (length key))))
3099
 
            (setq settings (project-collect-binding-list (cdr entry)
3100
 
                                                         root settings))))
 
3225
            (setq variables (dir-locals-collect-variables
 
3226
                             (cdr entry) root variables))))
3101
3227
         ((or (not key)
3102
3228
              (derived-mode-p key))
3103
 
          (setq settings (project-collect-bindings-from-alist (cdr entry)
3104
 
                                                              settings))))))))
 
3229
          (setq variables (dir-locals-collect-mode-variables
 
3230
                           (cdr entry) variables))))))))
3105
3231
 
3106
 
(defun set-directory-project (directory class)
3107
 
  "Declare that the project rooted at DIRECTORY is an instance of CLASS.
 
3232
(defun dir-locals-set-directory-class (directory class)
 
3233
  "Declare that the DIRECTORY root is an instance of CLASS.
3108
3234
DIRECTORY is the name of a directory, a string.
3109
3235
CLASS is the name of a project class, a symbol.
3110
3236
 
3111
3237
When a file beneath DIRECTORY is visited, the mode-specific
3112
 
settings from CLASS will be applied to the buffer.  The settings
3113
 
for a class are defined using `define-project-bindings'."
 
3238
variables from CLASS will be applied to the buffer.  The variables
 
3239
for a class are defined using `dir-locals-set-class-variables'."
3114
3240
  (setq directory (file-name-as-directory (expand-file-name directory)))
3115
 
  (unless (assq class project-class-alist)
3116
 
    (error "No such project class `%s'" (symbol-name class)))
3117
 
  (push (cons directory class) project-directory-alist))
 
3241
  (unless (assq class dir-locals-class-alist)
 
3242
    (error "No such class `%s'" (symbol-name class)))
 
3243
  (push (cons directory class) dir-locals-directory-alist))
3118
3244
 
3119
 
(defun define-project-bindings (class list)
3120
 
  "Map the project type CLASS to a list of variable settings.
3121
 
CLASS is the project class, a symbol.
3122
 
LIST is a list that declares variable settings for the class.
3123
 
An element in LIST is either of the form:
 
3245
(defun dir-locals-set-class-variables (class variables)
 
3246
  "Map the type CLASS to a list of variable settings.
 
3247
CLASS is the project class, a symbol.  VARIABLES is a list
 
3248
that declares directory-local variables for the class.
 
3249
An element in VARIABLES is either of the form:
3124
3250
    (MAJOR-MODE . ALIST)
3125
3251
or
3126
3252
    (DIRECTORY . LIST)
3132
3258
LIST is a list of the form accepted by the function.
3133
3259
 
3134
3260
When a file is visited, the file's class is found.  A directory
3135
 
may be assigned a class using `set-directory-project'.  Then
3136
 
variables are set in the file's buffer according to the class'
3137
 
LIST.  The list is processed in order.
 
3261
may be assigned a class using `dir-locals-set-directory-class'.
 
3262
Then variables are set in the file's buffer according to the
 
3263
class' LIST.  The list is processed in order.
3138
3264
 
3139
3265
* If the element is of the form (MAJOR-MODE . ALIST), and the
3140
3266
  buffer's major mode is derived from MAJOR-MODE (as determined
3141
 
  by `derived-mode-p'), then all the settings in ALIST are
 
3267
  by `derived-mode-p'), then all the variables in ALIST are
3142
3268
  applied.  A MAJOR-MODE of nil may be used to match any buffer.
3143
3269
  `make-local-variable' is called for each variable before it is
3144
3270
  set.
3146
3272
* If the element is of the form (DIRECTORY . LIST), and DIRECTORY
3147
3273
  is an initial substring of the file's directory, then LIST is
3148
3274
  applied by recursively following these rules."
3149
 
  (let ((elt (assq class project-class-alist)))
 
3275
  (let ((elt (assq class dir-locals-class-alist)))
3150
3276
    (if elt
3151
 
        (setcdr elt list)
3152
 
      (push (cons class list) project-class-alist))))
3153
 
 
3154
 
(defun project-find-settings-file (file)
3155
 
  "Find the settings file for FILE.
 
3277
        (setcdr elt variables)
 
3278
      (push (cons class variables) dir-locals-class-alist))))
 
3279
 
 
3280
(defconst dir-locals-file ".dir-locals.el"
 
3281
  "File that contains directory-local variables.
 
3282
It has to be constant to enforce uniform values
 
3283
across different environments and users.")
 
3284
 
 
3285
(defun dir-locals-find-file (file)
 
3286
  "Find the directory-local variables FILE.
3156
3287
This searches upward in the directory tree.
3157
 
If a settings file is found, the file name is returned.
3158
 
If the file is in a registered project, a cons from
3159
 
`project-directory-alist' is returned.
 
3288
If a local variables file is found, the file name is returned.
 
3289
If the file is already registered, a cons from
 
3290
`dir-locals-directory-alist' is returned.
3160
3291
Otherwise this returns nil."
3161
3292
  (setq file (expand-file-name file))
3162
 
  (let* ((settings (locate-dominating-file file "\\`\\.dir-settings\\.el\\'"))
3163
 
         (pda nil))
 
3293
  (let* ((dir-locals-file-name
 
3294
          (if (eq system-type 'ms-dos)
 
3295
              (dosified-file-name dir-locals-file)
 
3296
            dir-locals-file))
 
3297
         (locals-file (locate-dominating-file file dir-locals-file-name))
 
3298
         (dir-elt nil))
3164
3299
    ;; `locate-dominating-file' may have abbreviated the name.
3165
 
    (if settings (setq settings (expand-file-name settings)))
3166
 
    (dolist (x project-directory-alist)
3167
 
      (when (and (eq t (compare-strings file nil (length (car x))
3168
 
                                        (car x) nil nil))
3169
 
                 (> (length (car x)) (length (car pda))))
3170
 
        (setq pda x)))
3171
 
    (if (and settings pda)
3172
 
        (if (> (length (file-name-directory settings))
3173
 
               (length (car pda)))
3174
 
            settings pda)
3175
 
      (or settings pda))))
 
3300
    (when locals-file
 
3301
      (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
 
3302
    (dolist (elt dir-locals-directory-alist)
 
3303
      (when (and (eq t (compare-strings file nil (length (car elt))
 
3304
                                        (car elt) nil nil
 
3305
                                        (memq system-type
 
3306
                                              '(windows-nt cygwin ms-dos))))
 
3307
                 (> (length (car elt)) (length (car dir-elt))))
 
3308
        (setq dir-elt elt)))
 
3309
    (if (and locals-file dir-elt)
 
3310
        (if (> (length (file-name-directory locals-file))
 
3311
               (length (car dir-elt)))
 
3312
            locals-file
 
3313
          dir-elt)
 
3314
      (or locals-file dir-elt))))
3176
3315
 
3177
 
(defun project-define-from-project-file (settings-file)
3178
 
  "Load a settings file and register a new project class and instance.
3179
 
SETTINGS-FILE is the name of the file holding the settings to apply.
3180
 
The new class name is the same as the directory in which SETTINGS-FILE
 
3316
(defun dir-locals-read-from-file (file)
 
3317
  "Load a variables FILE and register a new class and instance.
 
3318
FILE is the name of the file holding the variables to apply.
 
3319
The new class name is the same as the directory in which FILE
3181
3320
is found.  Returns the new class name."
3182
3321
  (with-temp-buffer
3183
 
    ;; We should probably store the modtime of SETTINGS-FILE and then
 
3322
    ;; We should probably store the modtime of FILE and then
3184
3323
    ;; reload it whenever it changes.
3185
 
    (insert-file-contents settings-file)
3186
 
    (let* ((dir-name (file-name-directory settings-file))
 
3324
    (insert-file-contents file)
 
3325
    (let* ((dir-name (file-name-directory file))
3187
3326
           (class-name (intern dir-name))
3188
 
           (list (read (current-buffer))))
3189
 
      (define-project-bindings class-name list)
3190
 
      (set-directory-project dir-name class-name)
 
3327
           (variables (read (current-buffer))))
 
3328
      (dir-locals-set-class-variables class-name variables)
 
3329
      (dir-locals-set-directory-class dir-name class-name)
3191
3330
      class-name)))
3192
3331
 
3193
3332
(declare-function c-postprocess-file-styles "cc-mode" ())
3194
3333
 
3195
 
(defun hack-project-variables ()
3196
 
  "Read local variables for the current buffer based on project settings.
3197
 
Store the project variables in `file-local-variables-alist',
 
3334
(defun hack-dir-local-variables ()
 
3335
  "Read per-directory local variables for the current buffer.
 
3336
Store the directory-local variables in `file-local-variables-alist',
3198
3337
without applying them."
3199
3338
  (when (and enable-local-variables
3200
3339
             (buffer-file-name)
3201
3340
             (not (file-remote-p (buffer-file-name))))
3202
 
    ;; Find the settings file.
3203
 
    (let ((settings (project-find-settings-file (buffer-file-name)))
 
3341
    ;; Find the variables file.
 
3342
    (let ((variables-file (dir-locals-find-file (buffer-file-name)))
3204
3343
          (class nil)
3205
 
          (root-dir nil))
 
3344
          (dir-name nil))
3206
3345
      (cond
3207
 
       ((stringp settings)
3208
 
        (setq root-dir (file-name-directory (buffer-file-name)))
3209
 
        (setq class (project-define-from-project-file settings)))
3210
 
       ((consp settings)
3211
 
        (setq root-dir (car settings))
3212
 
        (setq class (cdr settings))))
 
3346
       ((stringp variables-file)
 
3347
        (setq dir-name (file-name-directory (buffer-file-name)))
 
3348
        (setq class (dir-locals-read-from-file variables-file)))
 
3349
       ((consp variables-file)
 
3350
        (setq dir-name (car variables-file))
 
3351
        (setq class (cdr variables-file))))
3213
3352
      (when class
3214
 
        (let ((bindings
3215
 
               (project-collect-binding-list (project-get-alist class)
3216
 
                                             root-dir nil)))
3217
 
          (when bindings
3218
 
            (hack-local-variables-filter bindings root-dir)))))))
 
3353
        (let ((variables
 
3354
               (dir-locals-collect-variables
 
3355
                (dir-locals-get-class-variables class) dir-name nil)))
 
3356
          (when variables
 
3357
            (hack-local-variables-filter variables dir-name)))))))
3219
3358
 
3220
3359
 
3221
3360
(defcustom change-major-mode-with-file-name t
3899
4038
See the subroutine `basic-save-buffer' for more information."
3900
4039
  (interactive "p")
3901
4040
  (let ((modp (buffer-modified-p))
3902
 
        (large (> (buffer-size) 50000))
3903
4041
        (make-backup-files (or (and make-backup-files (not (eq args 0)))
3904
4042
                               (memq args '(16 64)))))
3905
4043
    (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
3906
 
    (if (and modp large (buffer-file-name))
 
4044
    ;; We used to display the message below only for files > 50KB, but
 
4045
    ;; then Rmail-mbox never displays it due to buffer swapping.  If
 
4046
    ;; the test is ever re-introduced, be sure to handle saving of
 
4047
    ;; Rmail files.
 
4048
    (if (and modp (buffer-file-name))
3907
4049
        (message "Saving file %s..." (buffer-file-name)))
3908
4050
    (basic-save-buffer)
3909
4051
    (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
4045
4187
          (let ((coding-system-for-write save-buffer-coding-system))
4046
4188
            (basic-save-buffer-2))
4047
4189
        (basic-save-buffer-2))
4048
 
    (setq buffer-file-coding-system-explicit last-coding-system-used)))
 
4190
    (if buffer-file-coding-system-explicit
 
4191
        (setcar buffer-file-coding-system-explicit last-coding-system-used)
 
4192
      (setq buffer-file-coding-system-explicit
 
4193
            (cons last-coding-system-used nil)))))
4049
4194
 
4050
4195
;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
4051
4196
(defun basic-save-buffer-2 ()
4066
4211
                (error "Attempt to save to a file which you aren't allowed to write"))))))
4067
4212
    (or buffer-backed-up
4068
4213
        (setq setmodes (backup-buffer)))
4069
 
    (let ((dir (file-name-directory buffer-file-name)))
4070
 
      (if (and file-precious-flag
4071
 
               (file-writable-p dir))
4072
 
          ;; If file is precious, write temp name, then rename it.
 
4214
    (let* ((dir (file-name-directory buffer-file-name))
 
4215
           (dir-writable (file-writable-p dir)))
 
4216
      (if (or (and file-precious-flag dir-writable)
 
4217
              (and break-hardlink-on-save
 
4218
                   (> (file-nlinks buffer-file-name) 1)
 
4219
                   (or dir-writable
 
4220
                       (error (concat (format
 
4221
                                       "Directory %s write-protected; " dir)
 
4222
                                      "cannot break hardlink when saving")))))
 
4223
          ;; Write temp name, then rename it.
4073
4224
          ;; This requires write access to the containing dir,
4074
4225
          ;; which is why we don't try it if we don't have that access.
4075
4226
          (let ((realname buffer-file-name)
4227
4378
      (setq files-done
4228
4379
            (map-y-or-n-p
4229
4380
             (lambda (buffer)
4230
 
               (and (buffer-modified-p buffer)
 
4381
               ;; Note that killing some buffers may kill others via
 
4382
               ;; hooks (e.g. Rmail and its viewing buffer).
 
4383
               (and (buffer-live-p buffer)
 
4384
                    (buffer-modified-p buffer)
4231
4385
                    (not (buffer-base-buffer buffer))
4232
4386
                    (or
4233
4387
                     (buffer-file-name buffer)
4270
4424
 
4271
4425
(defun not-modified (&optional arg)
4272
4426
  "Mark current buffer as unmodified, not needing to be saved.
4273
 
With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
 
4427
With prefix ARG, mark buffer as modified, so \\[save-buffer] will save.
4274
4428
 
4275
4429
It is not a good idea to use this function in Lisp programs, because it
4276
4430
prints a message in the minibuffer.  Instead, use `set-buffer-modified-p'."
4280
4434
  (set-buffer-modified-p arg))
4281
4435
 
4282
4436
(defun toggle-read-only (&optional arg)
4283
 
  "Change whether this buffer is visiting its file read-only.
 
4437
  "Change whether this buffer is read-only.
4284
4438
With prefix argument ARG, make the buffer read-only if ARG is
4285
 
positive, otherwise make it writable.  If visiting file read-only
 
4439
positive, otherwise make it writable.  If buffer is read-only
4286
4440
and `view-read-only' is non-nil, enter view mode."
4287
4441
  (interactive "P")
4288
4442
  (if (and arg
4390
4544
          (make-directory-internal dir)
4391
4545
        (let ((dir (directory-file-name (expand-file-name dir)))
4392
4546
              create-list)
4393
 
          (while (not (file-exists-p dir))
 
4547
          (while (and (not (file-exists-p dir))
 
4548
                      ;; If directory is its own parent, then we can't
 
4549
                      ;; keep looping forever
 
4550
                      (not (equal dir
 
4551
                                  (directory-file-name
 
4552
                                   (file-name-directory dir)))))
4394
4553
            (setq create-list (cons dir create-list)
4395
4554
                  dir (directory-file-name (file-name-directory dir))))
4396
4555
          (while create-list
4453
4612
This command also implements an interface for special buffers
4454
4613
that contain text which doesn't come from a file, but reflects
4455
4614
some other data instead (e.g. Dired buffers, `buffer-list'
4456
 
buffers).  This is done via the variable
4457
 
`revert-buffer-function'.  In these cases, it should reconstruct
4458
 
the buffer contents from the appropriate data.
 
4615
buffers).  This is done via the variable `revert-buffer-function'.
 
4616
In these cases, it should reconstruct the buffer contents from the
 
4617
appropriate data.
4459
4618
 
4460
4619
When called from Lisp, the first argument is IGNORE-AUTO; only offer
4461
4620
to revert from the auto-save file when this is nil.  Note that the
4463
4622
sake of backward compatibility.  IGNORE-AUTO is optional, defaulting
4464
4623
to nil.
4465
4624
 
4466
 
Optional second argument NOCONFIRM means don't ask for confirmation at
4467
 
all.  \(The variable `revert-without-query' offers another way to
 
4625
Optional second argument NOCONFIRM means don't ask for confirmation
 
4626
at all.  \(The variable `revert-without-query' offers another way to
4468
4627
revert buffers without querying for confirmation.)
4469
4628
 
4470
4629
Optional third argument PRESERVE-MODES non-nil means don't alter
4549
4708
                          ;; internal coding.
4550
4709
                          (if auto-save-p 'auto-save-coding
4551
4710
                            (or coding-system-for-read
4552
 
                                buffer-file-coding-system-explicit))))
 
4711
                                (and
 
4712
                                 buffer-file-coding-system-explicit
 
4713
                                 (car buffer-file-coding-system-explicit))))))
4553
4714
                     (if (and (not enable-multibyte-characters)
4554
4715
                              coding-system-for-read
4555
4716
                              (not (memq (coding-system-base
4743
4904
      (kill-buffer buffer))))
4744
4905
 
4745
4906
(defun kill-buffer-ask (buffer)
4746
 
  "Kill buffer if confirmed."
 
4907
  "Kill BUFFER if confirmed."
4747
4908
  (when (yes-or-no-p
4748
4909
         (format "Buffer %s %s.  Kill? " (buffer-name buffer)
4749
4910
                 (if (buffer-modified-p buffer)
4768
4929
    (setq list (cdr list))))
4769
4930
 
4770
4931
(defun kill-matching-buffers (regexp &optional internal-too)
4771
 
  "Kill buffers whose name matches the specified regexp.
 
4932
  "Kill buffers whose name matches the specified REGEXP.
4772
4933
The optional second argument indicates whether to kill internal buffers too."
4773
4934
  (interactive "sKill buffers matching this regular expression: \nP")
4774
4935
  (dolist (buffer (buffer-list))
5175
5336
      (save-match-data
5176
5337
        (with-temp-buffer
5177
5338
          (when (and directory-free-space-program
5178
 
                     (eq 0 (call-process directory-free-space-program
 
5339
                     (let ((default-directory
 
5340
                             (if (and (not (file-remote-p default-directory))
 
5341
                                      (file-directory-p default-directory)
 
5342
                                      (file-readable-p default-directory))
 
5343
                                 default-directory
 
5344
                               (expand-file-name "~/"))))
 
5345
                       (eq (call-process directory-free-space-program
5179
5346
                                         nil t nil
5180
5347
                                         directory-free-space-args
5181
 
                                         dir)))
 
5348
                                         dir)
 
5349
                           0)))
5182
5350
            ;; Usual format is a header line followed by a line of
5183
5351
            ;; numbers.
5184
5352
            (goto-char (point-min))
5562
5730
 
5563
5731
(defun save-buffers-kill-emacs (&optional arg)
5564
5732
  "Offer to save each buffer, then kill this Emacs process.
5565
 
With prefix arg, silently save all file-visiting buffers, then kill."
 
5733
With prefix ARG, silently save all file-visiting buffers, then kill."
5566
5734
  (interactive "P")
5567
5735
  (save-some-buffers arg t)
5568
5736
  (and (or (not (memq t (mapcar (function
5592
5760
  "Offer to save each buffer, then kill the current connection.
5593
5761
If the current frame has no client, kill Emacs itself.
5594
5762
 
5595
 
With prefix arg, silently save all file-visiting buffers, then kill.
 
5763
With prefix ARG, silently save all file-visiting buffers, then kill.
5596
5764
 
5597
5765
If emacsclient was started with a list of filenames to edit, then
5598
5766
only these files will be asked to be saved."
5599
5767
  (interactive "P")
5600
 
  (let ((proc (frame-parameter (selected-frame) 'client))
5601
 
        (frame (selected-frame)))
5602
 
    (if (null proc)
5603
 
        (save-buffers-kill-emacs)
5604
 
      (server-save-buffers-kill-terminal proc arg))))
5605
 
 
 
5768
  (if (frame-parameter (selected-frame) 'client)
 
5769
      (server-save-buffers-kill-terminal arg)
 
5770
    (save-buffers-kill-emacs arg)))
5606
5771
 
5607
5772
;; We use /: as a prefix to "quote" a file name
5608
5773
;; so that magic file name handlers will not apply to it.
5694
5859
;; Symbolic modes and read-file-modes.
5695
5860
 
5696
5861
(defun file-modes-char-to-who (char)
5697
 
  "Convert CHAR to a who-mask from a symbolic mode notation.
5698
 
CHAR is in [ugoa] and represents the users on which rights are applied."
 
5862
  "Convert CHAR to a numeric bit-mask for extracting mode bits.
 
5863
CHAR is in [ugoa] and represents the category of users (Owner, Group,
 
5864
Others, or All) for whom to produce the mask.
 
5865
The bit-mask that is returned extracts from mode bits the access rights
 
5866
for the specified category of users."
5699
5867
  (cond ((= char ?u) #o4700)
5700
5868
        ((= char ?g) #o2070)
5701
5869
        ((= char ?o) #o1007)
5703
5871
        (t (error "%c: bad `who' character" char))))
5704
5872
 
5705
5873
(defun file-modes-char-to-right (char &optional from)
5706
 
  "Convert CHAR to a right-mask from a symbolic mode notation.
5707
 
CHAR is in [rwxXstugo] and represents a right.
5708
 
If CHAR is in [Xugo], the value is extracted from FROM (or 0 if nil)."
 
5874
  "Convert CHAR to a numeric value of mode bits.
 
5875
CHAR is in [rwxXstugo] and represents symbolic access permissions.
 
5876
If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
5709
5877
  (or from (setq from 0))
5710
5878
  (cond ((= char ?r) #o0444)
5711
5879
        ((= char ?w) #o0222)
5723
5891
        (t (error "%c: bad right character" char))))
5724
5892
 
5725
5893
(defun file-modes-rights-to-number (rights who-mask &optional from)
5726
 
  "Convert a right string to a right-mask from a symbolic modes notation.
5727
 
RIGHTS is the right string, it should match \"([+=-][rwxXstugo]+)+\".
5728
 
WHO-MASK is the mask number of the users on which the rights are to be applied.
5729
 
FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
 
5894
  "Convert a symbolic mode string specification to an equivalent number.
 
5895
RIGHTS is the symbolic mode spec, it should match \"([+=-][rwxXstugo]+)+\".
 
5896
WHO-MASK is the bit-mask specifying the category of users to which to
 
5897
apply the access permissions.  See `file-modes-char-to-who'.
 
5898
FROM (or 0 if nil) gives the mode bits on which to base permissions if
 
5899
RIGHTS request to add, remove, or set permissions based on existing ones,
 
5900
as in \"og+rX-w\"."
5730
5901
  (let* ((num-rights (or from 0))
5731
5902
         (list-rights (string-to-list rights))
5732
5903
         (op (pop list-rights)))
5752
5923
\"[ugoa]*([+-=][rwxXstugo]+)+,...\".
5753
5924
See (info \"(coreutils)File permissions\") for more information on this
5754
5925
notation.
5755
 
FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
 
5926
FROM (or 0 if nil) gives the mode bits on which to base permissions if
 
5927
MODES request to add, remove, or set permissions based on existing ones,
 
5928
as in \"og+rX-w\"."
5756
5929
  (save-match-data
5757
5930
    (let ((case-fold-search nil)
5758
5931
          (num-modes (or from 0)))
5771
5944
      num-modes)))
5772
5945
 
5773
5946
(defun read-file-modes (&optional prompt orig-file)
5774
 
  "Read file modes in octal or symbolic notation.
 
5947
  "Read file modes in octal or symbolic notation and return its numeric value.
5775
5948
PROMPT is used as the prompt, default to `File modes (octal or symbolic): '.
5776
 
ORIG-FILE is the original file of which modes will be changed."
 
5949
ORIG-FILE is the name of a file on whose mode bits to base returned
 
5950
permissions if what user types requests to add, remove, or set permissions
 
5951
based on existing mode bits, as in \"og+rX-w\"."
5777
5952
  (let* ((modes (or (if orig-file (file-modes orig-file) 0)
5778
5953
                    (error "File not found")))
5779
5954
         (modestr (and (stringp orig-file)
5795
5970
        (file-modes-symbolic-to-number value modes)))))
5796
5971
 
5797
5972
 
5798
 
;; Trash can handling.
5799
 
(defcustom trash-directory "~/.Trash"
 
5973
;; Trashcan handling.
 
5974
(defcustom trash-directory (convert-standard-filename "~/.Trash")
5800
5975
  "Directory for `move-file-to-trash' to move files and directories to.
5801
5976
This directory is only used when the function `system-move-file-to-trash' is
5802
5977
not defined.  Relative paths are interpreted relative to `default-directory'.
5828
6003
      (and (file-exists-p new-fn)
5829
6004
           ;; make new-fn unique.
5830
6005
           ;; example: "~/.Trash/abc.txt" -> "~/.Trash/abc.txt.~1~"
5831
 
           (let ((version-control t))
 
6006
           (let ((version-control t)
 
6007
                 (backup-directory-alist nil))
5832
6008
             (setq new-fn (car (find-backup-file-name new-fn)))))
5833
6009
      ;; stop processing if fn is same or parent directory of trash-dir.
5834
6010
      (and (string-match fn trash-dir)