LCOV - code coverage report
Current view: top level - lisp - files.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 892 3058 29.2 %
Date: 2017-08-30 10:12:24 Functions: 78 197 39.6 %

          Line data    Source code
       1             : ;;; files.el --- file input and output commands for Emacs  -*- lexical-binding:t -*-
       2             : 
       3             : ;; Copyright (C) 1985-1987, 1992-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Maintainer: emacs-devel@gnu.org
       6             : ;; Package: emacs
       7             : 
       8             : ;; This file is part of GNU Emacs.
       9             : 
      10             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      11             : ;; it under the terms of the GNU General Public License as published by
      12             : ;; the Free Software Foundation, either version 3 of the License, or
      13             : ;; (at your option) any later version.
      14             : 
      15             : ;; GNU Emacs is distributed in the hope that it will be useful,
      16             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      17             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      18             : ;; GNU General Public License for more details.
      19             : 
      20             : ;; You should have received a copy of the GNU General Public License
      21             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      22             : 
      23             : ;;; Commentary:
      24             : 
      25             : ;; Defines most of Emacs's file- and directory-handling functions,
      26             : ;; including basic file visiting, backup generation, link handling,
      27             : ;; ITS-id version control, load- and write-hook handling, and the like.
      28             : 
      29             : ;;; Code:
      30             : 
      31             : (eval-when-compile
      32             :   (require 'pcase)
      33             :   (require 'easy-mmode)) ; For `define-minor-mode'.
      34             : 
      35             : (defvar font-lock-keywords)
      36             : 
      37             : (defgroup backup nil
      38             :   "Backups of edited data files."
      39             :   :group 'files)
      40             : 
      41             : (defgroup find-file nil
      42             :   "Finding files."
      43             :   :group 'files)
      44             : 
      45             : 
      46             : (defcustom delete-auto-save-files t
      47             :   "Non-nil means delete auto-save file when a buffer is saved or killed.
      48             : 
      49             : Note that the auto-save file will not be deleted if the buffer is killed
      50             : when it has unsaved changes."
      51             :   :type 'boolean
      52             :   :group 'auto-save)
      53             : 
      54             : (defcustom directory-abbrev-alist
      55             :   nil
      56             :   "Alist of abbreviations for file directories.
      57             : A list of elements of the form (FROM . TO), each meaning to replace
      58             : a match for FROM with TO when a directory name matches FROM.  This
      59             : replacement is done when setting up the default directory of a
      60             : newly visited file buffer.
      61             : 
      62             : FROM is a regexp that is matched against directory names anchored at
      63             : the first character, so it should start with a \"\\\\\\=`\", or, if
      64             : directory names cannot have embedded newlines, with a \"^\".
      65             : 
      66             : FROM and TO should be equivalent names, which refer to the
      67             : same directory.  TO should be an absolute directory name.
      68             : Do not use `~' in the TO strings.
      69             : 
      70             : Use this feature when you have directories which you normally refer to
      71             : via absolute symbolic links.  Make TO the name of the link, and FROM
      72             : a regexp matching the name it is linked to."
      73             :   :type '(repeat (cons :format "%v"
      74             :                        :value ("\\`" . "")
      75             :                        (regexp :tag "From")
      76             :                        (string :tag "To")))
      77             :   :group 'abbrev
      78             :   :group 'find-file)
      79             : 
      80             : (defcustom make-backup-files t
      81             :   "Non-nil means make a backup of a file the first time it is saved.
      82             : This can be done by renaming the file or by copying.
      83             : 
      84             : Renaming means that Emacs renames the existing file so that it is a
      85             : backup file, then writes the buffer into a new file.  Any other names
      86             : that the old file had will now refer to the backup file.  The new file
      87             : is owned by you and its group is defaulted.
      88             : 
      89             : Copying means that Emacs copies the existing file into the backup
      90             : file, then writes the buffer on top of the existing file.  Any other
      91             : names that the old file had will now refer to the new (edited) file.
      92             : The file's owner and group are unchanged.
      93             : 
      94             : The choice of renaming or copying is controlled by the variables
      95             : `backup-by-copying', `backup-by-copying-when-linked',
      96             : `backup-by-copying-when-mismatch' and
      97             : `backup-by-copying-when-privileged-mismatch'.  See also `backup-inhibited'."
      98             :   :type 'boolean
      99             :   :group 'backup)
     100             : 
     101             : ;; Do this so that local variables based on the file name
     102             : ;; are not overridden by the major mode.
     103             : (defvar backup-inhibited nil
     104             :   "If non-nil, backups will be inhibited.
     105             : This variable is intended for use by making it local to a buffer,
     106             : but it is not an automatically buffer-local variable.")
     107             : (put 'backup-inhibited 'permanent-local t)
     108             : 
     109             : (defcustom backup-by-copying nil
     110             :  "Non-nil means always use copying to create backup files.
     111             : See documentation of variable `make-backup-files'."
     112             :   :type 'boolean
     113             :   :group 'backup)
     114             : 
     115             : (defcustom backup-by-copying-when-linked nil
     116             :  "Non-nil means use copying to create backups for files with multiple names.
     117             : This causes the alternate names to refer to the latest version as edited.
     118             : This variable is relevant only if `backup-by-copying' is nil."
     119             :   :type 'boolean
     120             :   :group 'backup)
     121             : 
     122             : (defcustom backup-by-copying-when-mismatch t
     123             :   "Non-nil means create backups by copying if this preserves owner or group.
     124             : Renaming may still be used (subject to control of other variables)
     125             : when it would not result in changing the owner or group of the file;
     126             : that is, for files which are owned by you and whose group matches
     127             : the default for a new file created there by you.
     128             : This variable is relevant only if `backup-by-copying' is nil."
     129             :   :version "24.1"
     130             :   :type 'boolean
     131             :   :group 'backup)
     132             : (put 'backup-by-copying-when-mismatch 'permanent-local t)
     133             : 
     134             : (defcustom backup-by-copying-when-privileged-mismatch 200
     135             :   "Non-nil means create backups by copying to preserve a privileged owner.
     136             : Renaming may still be used (subject to control of other variables)
     137             : when it would not result in changing the owner of the file or if the owner
     138             : has a user id greater than the value of this variable.  This is useful
     139             : when low-numbered uid's are used for special system users (such as root)
     140             : that must maintain ownership of certain files.
     141             : This variable is relevant only if `backup-by-copying' and
     142             : `backup-by-copying-when-mismatch' are nil."
     143             :   :type '(choice (const nil) integer)
     144             :   :group 'backup)
     145             : 
     146             : (defvar backup-enable-predicate 'normal-backup-enable-predicate
     147             :   "Predicate that looks at a file name and decides whether to make backups.
     148             : Called with an absolute file name as argument, it returns t to enable backup.")
     149             : 
     150             : (defcustom buffer-offer-save nil
     151             :   "Non-nil in a buffer means always offer to save buffer on exit.
     152             : Do so even if the buffer is not visiting a file.
     153             : Automatically local in all buffers."
     154             :   :type 'boolean
     155             :   :group 'backup)
     156             : (make-variable-buffer-local 'buffer-offer-save)
     157             : (put 'buffer-offer-save 'permanent-local t)
     158             : 
     159             : (defcustom find-file-existing-other-name t
     160             :   "Non-nil means find a file under alternative names, in existing buffers.
     161             : This means if any existing buffer is visiting the file you want
     162             : under another name, you get the existing buffer instead of a new buffer."
     163             :   :type 'boolean
     164             :   :group 'find-file)
     165             : 
     166             : (defcustom find-file-visit-truename nil
     167             :   "Non-nil means visiting a file uses its truename as the visited-file name.
     168             : That is, the buffer visiting the file has the truename as the
     169             : value of `buffer-file-name'.  The truename of a file is found by
     170             : chasing all links both at the file level and at the levels of the
     171             : containing directories."
     172             :   :type 'boolean
     173             :   :group 'find-file)
     174             : (put 'find-file-visit-truename 'safe-local-variable 'booleanp)
     175             : 
     176             : (defcustom revert-without-query nil
     177             :   "Specify which files should be reverted without query.
     178             : The value is a list of regular expressions.
     179             : If the file name matches one of these regular expressions,
     180             : then `revert-buffer' reverts the file without querying
     181             : if the file has changed on disk and you have not edited the buffer."
     182             :   :type '(repeat regexp)
     183             :   :group 'find-file)
     184             : 
     185             : (defvar buffer-file-number nil
     186             :   "The device number and file number of the file visited in the current buffer.
     187             : The value is a list of the form (FILENUM DEVNUM).
     188             : This pair of numbers uniquely identifies the file.
     189             : If the buffer is visiting a new file, the value is nil.")
     190             : (make-variable-buffer-local 'buffer-file-number)
     191             : (put 'buffer-file-number 'permanent-local t)
     192             : 
     193             : (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
     194             :   "Non-nil means that `buffer-file-number' uniquely identifies files.")
     195             : 
     196             : (defvar buffer-file-read-only nil
     197             :   "Non-nil if visited file was read-only when visited.")
     198             : (make-variable-buffer-local 'buffer-file-read-only)
     199             : 
     200             : (defcustom small-temporary-file-directory
     201             :   (if (eq system-type 'ms-dos) (getenv "TMPDIR"))
     202             :   "The directory for writing small temporary files.
     203             : If non-nil, this directory is used instead of `temporary-file-directory'
     204             : by programs that create small temporary files.  This is for systems that
     205             : have fast storage with limited space, such as a RAM disk."
     206             :   :group 'files
     207             :   :initialize 'custom-initialize-delay
     208             :   :type '(choice (const nil) directory))
     209             : 
     210             : ;; The system null device. (Should reference NULL_DEVICE from C.)
     211             : (defvar null-device (purecopy "/dev/null") "The system null device.")
     212             : 
     213             : (declare-function msdos-long-file-names "msdos.c")
     214             : (declare-function w32-long-file-name "w32proc.c")
     215             : (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
     216             : (declare-function dired-unmark "dired" (arg &optional interactive))
     217             : (declare-function dired-do-flagged-delete "dired" (&optional nomessage))
     218             : (declare-function dos-8+3-filename "dos-fns" (filename))
     219             : (declare-function dosified-file-name "dos-fns" (file-name))
     220             : 
     221             : (defvar file-name-invalid-regexp
     222             :   (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
     223             :          (purecopy
     224             :          (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
     225             :                  "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|"  ; invalid characters
     226             :                  "[\000-\037]\\|"               ; control characters
     227             :                  "\\(/\\.\\.?[^/]\\)\\|"        ; leading dots
     228             :                  "\\(/[^/.]+\\.[^/.]*\\.\\)")))         ; more than a single dot
     229             :         ((memq system-type '(ms-dos windows-nt cygwin))
     230             :          (purecopy
     231             :          (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
     232             :                  "[|<>\"?*\000-\037]")))             ; invalid characters
     233             :         (t (purecopy "[\000]")))
     234             :   "Regexp recognizing file names which aren't allowed by the filesystem.")
     235             : 
     236             : (defcustom file-precious-flag nil
     237             :   "Non-nil means protect against I/O errors while saving files.
     238             : Some modes set this non-nil in particular buffers.
     239             : 
     240             : This feature works by writing the new contents into a temporary file
     241             : and then renaming the temporary file to replace the original.
     242             : In this way, any I/O error in writing leaves the original untouched,
     243             : and there is never any instant where the file is nonexistent.
     244             : 
     245             : Note that this feature forces backups to be made by copying.
     246             : Yet, at the same time, saving a precious file
     247             : breaks any hard links between it and other files.
     248             : 
     249             : This feature is advisory: for example, if the directory in which the
     250             : file is being saved is not writable, Emacs may ignore a non-nil value
     251             : of `file-precious-flag' and write directly into the file.
     252             : 
     253             : See also: `break-hardlink-on-save'."
     254             :   :type 'boolean
     255             :   :group 'backup)
     256             : 
     257             : (defcustom break-hardlink-on-save nil
     258             :   "Whether to allow breaking hardlinks when saving files.
     259             : If non-nil, then when saving a file that exists under several
     260             : names \(i.e., has multiple hardlinks), break the hardlink
     261             : associated with `buffer-file-name' and write to a new file, so
     262             : that the other instances of the file are not affected by the
     263             : save.
     264             : 
     265             : If `buffer-file-name' refers to a symlink, do not break the symlink.
     266             : 
     267             : Unlike `file-precious-flag', `break-hardlink-on-save' is not advisory.
     268             : For example, if the directory in which a file is being saved is not
     269             : itself writable, then error instead of saving in some
     270             : hardlink-nonbreaking way.
     271             : 
     272             : See also `backup-by-copying' and `backup-by-copying-when-linked'."
     273             :   :type 'boolean
     274             :   :group 'files
     275             :   :version "23.1")
     276             : 
     277             : (defcustom version-control nil
     278             :   "Control use of version numbers for backup files.
     279             : When t, make numeric backup versions unconditionally.
     280             : When nil, make them for files that have some already.
     281             : The value `never' means do not make them."
     282             :   :type '(choice (const :tag "Never" never)
     283             :                  (const :tag "If existing" nil)
     284             :                  (other :tag "Always" t))
     285             :   :group 'backup)
     286             : 
     287             : (defun version-control-safe-local-p (x)
     288             :   "Return whether X is safe as local value for `version-control'."
     289          19 :   (or (booleanp x) (equal x 'never)))
     290             : 
     291             : (put 'version-control 'safe-local-variable
     292             :      #'version-control-safe-local-p)
     293             : 
     294             : (defcustom dired-kept-versions 2
     295             :   "When cleaning directory, number of versions to keep."
     296             :   :type 'integer
     297             :   :group 'backup
     298             :   :group 'dired)
     299             : 
     300             : (defcustom delete-old-versions nil
     301             :   "If t, delete excess backup versions silently.
     302             : If nil, ask confirmation.  Any other value prevents any trimming."
     303             :   :type '(choice (const :tag "Delete" t)
     304             :                  (const :tag "Ask" nil)
     305             :                  (other :tag "Leave" other))
     306             :   :group 'backup)
     307             : 
     308             : (defcustom kept-old-versions 2
     309             :   "Number of oldest versions to keep when a new numbered backup is made."
     310             :   :type 'integer
     311             :   :group 'backup)
     312             : (put 'kept-old-versions 'safe-local-variable 'integerp)
     313             : 
     314             : (defcustom kept-new-versions 2
     315             :   "Number of newest versions to keep when a new numbered backup is made.
     316             : Includes the new backup.  Must be > 0"
     317             :   :type 'integer
     318             :   :group 'backup)
     319             : (put 'kept-new-versions 'safe-local-variable 'integerp)
     320             : 
     321             : (defcustom require-final-newline nil
     322             :   "Whether to add a newline automatically at the end of the file.
     323             : 
     324             : A value of t means do this only when the file is about to be saved.
     325             : A value of `visit' means do this right after the file is visited.
     326             : A value of `visit-save' means do it at both of those times.
     327             : Any other non-nil value means ask user whether to add a newline, when saving.
     328             : A value of nil means don't add newlines.
     329             : 
     330             : Certain major modes set this locally to the value obtained
     331             : from `mode-require-final-newline'."
     332             :   :safe #'symbolp
     333             :   :type '(choice (const :tag "When visiting" visit)
     334             :                  (const :tag "When saving" t)
     335             :                  (const :tag "When visiting or saving" visit-save)
     336             :                  (const :tag "Don't add newlines" nil)
     337             :                  (other :tag "Ask each time" ask))
     338             :   :group 'editing-basics)
     339             : 
     340             : (defcustom mode-require-final-newline t
     341             :   "Whether to add a newline at end of file, in certain major modes.
     342             : Those modes set `require-final-newline' to this value when you enable them.
     343             : They do so because they are often used for files that are supposed
     344             : to end in newlines, and the question is how to arrange that.
     345             : 
     346             : A value of t means do this only when the file is about to be saved.
     347             : A value of `visit' means do this right after the file is visited.
     348             : A value of `visit-save' means do it at both of those times.
     349             : Any other non-nil value means ask user whether to add a newline, when saving.
     350             : 
     351             : A value of nil means do not add newlines.  That is a risky choice in this
     352             : variable since this value is used for modes for files that ought to have
     353             : final newlines.  So if you set this to nil, you must explicitly check and
     354             : add a final newline, whenever you save a file that really needs one."
     355             :   :type '(choice (const :tag "When visiting" visit)
     356             :                  (const :tag "When saving" t)
     357             :                  (const :tag "When visiting or saving" visit-save)
     358             :                  (const :tag "Don't add newlines" nil)
     359             :                  (other :tag "Ask each time" ask))
     360             :   :group 'editing-basics
     361             :   :version "22.1")
     362             : 
     363             : (defcustom auto-save-default t
     364             :   "Non-nil says by default do auto-saving of every file-visiting buffer."
     365             :   :type 'boolean
     366             :   :group 'auto-save)
     367             : 
     368             : (defcustom auto-save-file-name-transforms
     369             :   `(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
     370             :      ;; Don't put "\\2" inside expand-file-name, since it will be
     371             :      ;; transformed to "/2" on DOS/Windows.
     372             :      ,(concat temporary-file-directory "\\2") t))
     373             :   "Transforms to apply to buffer file name before making auto-save file name.
     374             : Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
     375             : REGEXP is a regular expression to match against the file name.
     376             : If it matches, `replace-match' is used to replace the
     377             : matching part with REPLACEMENT.
     378             : If the optional element UNIQUIFY is non-nil, the auto-save file name is
     379             : constructed by taking the directory part of the replaced file-name,
     380             : concatenated with the buffer file name with all directory separators
     381             : changed to `!' to prevent clashes.  This will not work
     382             : correctly if your filesystem truncates the resulting name.
     383             : 
     384             : All the transforms in the list are tried, in the order they are listed.
     385             : When one transform applies, its result is final;
     386             : no further transforms are tried.
     387             : 
     388             : The default value is set up to put the auto-save file into the
     389             : temporary directory (see the variable `temporary-file-directory') for
     390             : editing a remote file.
     391             : 
     392             : On MS-DOS filesystems without long names this variable is always
     393             : ignored."
     394             :   :group 'auto-save
     395             :   :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")
     396             :                                            (boolean :tag "Uniquify")))
     397             :   :initialize 'custom-initialize-delay
     398             :   :version "21.1")
     399             : 
     400             : (defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.")
     401             : 
     402             : (defcustom auto-save-visited-interval 5
     403             :   "Interval in seconds for `auto-save-visited-mode'.
     404             : If `auto-save-visited-mode' is enabled, Emacs will save all
     405             : buffers visiting a file to the visited file after it has been
     406             : idle for `auto-save-visited-interval' seconds."
     407             :   :group 'auto-save
     408             :   :type 'number
     409             :   :version "26.1"
     410             :   :set (lambda (symbol value)
     411             :          (set-default symbol value)
     412             :          (when auto-save--timer
     413             :            (timer-set-idle-time auto-save--timer value :repeat))))
     414             : 
     415             : (define-minor-mode auto-save-visited-mode
     416             :   "Toggle automatic saving to file-visiting buffers on or off.
     417             : With a prefix argument ARG, enable regular saving of all buffers
     418             : visiting a file if ARG is positive, and disable it otherwise.
     419             : Unlike `auto-save-mode', this mode will auto-save buffer contents
     420             : to the visited files directly and will also run all save-related
     421             : hooks.  See Info node `Saving' for details of the save process.
     422             : 
     423             : If called from Lisp, enable the mode if ARG is omitted or nil,
     424             : and toggle it if ARG is `toggle'."
     425             :   :group 'auto-save
     426             :   :global t
     427           0 :   (when auto-save--timer (cancel-timer auto-save--timer))
     428           0 :   (setq auto-save--timer
     429           0 :         (when auto-save-visited-mode
     430           0 :           (run-with-idle-timer
     431           0 :            auto-save-visited-interval :repeat
     432           0 :            #'save-some-buffers :no-prompt
     433             :            (lambda ()
     434           0 :              (not (and buffer-auto-save-file-name
     435           0 :                        auto-save-visited-file-name)))))))
     436             : 
     437             : ;; The 'set' part is so we don't get a warning for using this variable
     438             : ;; above, while still catching code that _sets_ the variable to get
     439             : ;; the same effect as the new auto-save-visited-mode.
     440             : (make-obsolete-variable 'auto-save-visited-file-name 'auto-save-visited-mode
     441             :                         "Emacs 26.1" 'set)
     442             : 
     443             : (defcustom save-abbrevs t
     444             :   "Non-nil means save word abbrevs too when files are saved.
     445             : If `silently', don't ask the user before saving."
     446             :   :type '(choice (const t) (const nil) (const silently))
     447             :   :group 'abbrev)
     448             : 
     449             : (defcustom find-file-run-dired t
     450             :   "Non-nil means allow `find-file' to visit directories.
     451             : To visit the directory, `find-file' runs `find-directory-functions'."
     452             :   :type 'boolean
     453             :   :group 'find-file)
     454             : 
     455             : (defcustom find-directory-functions '(cvs-dired-noselect dired-noselect)
     456             :   "List of functions to try in sequence to visit a directory.
     457             : Each function is called with the directory name as the sole argument
     458             : and should return either a buffer or nil."
     459             :   :type '(hook :options (cvs-dired-noselect dired-noselect))
     460             :   :group 'find-file)
     461             : 
     462             : ;; FIXME: also add a hook for `(thing-at-point 'filename)'
     463             : (defcustom file-name-at-point-functions '(ffap-guess-file-name-at-point)
     464             :   "List of functions to try in sequence to get a file name at point.
     465             : Each function should return either nil or a file name found at the
     466             : location of point in the current buffer."
     467             :   :type '(hook :options (ffap-guess-file-name-at-point))
     468             :   :group 'find-file)
     469             : 
     470             : ;;;It is not useful to make this a local variable.
     471             : ;;;(put 'find-file-not-found-hooks 'permanent-local t)
     472             : (define-obsolete-variable-alias 'find-file-not-found-hooks
     473             :     'find-file-not-found-functions "22.1")
     474             : (defvar find-file-not-found-functions nil
     475             :   "List of functions to be called for `find-file' on nonexistent file.
     476             : These functions are called as soon as the error is detected.
     477             : Variable `buffer-file-name' is already set up.
     478             : The functions are called in the order given until one of them returns non-nil.")
     479             : 
     480             : ;;;It is not useful to make this a local variable.
     481             : ;;;(put 'find-file-hooks 'permanent-local t)
     482             : (define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1")
     483             : (defcustom find-file-hook nil
     484             :   "List of functions to be called after a buffer is loaded from a file.
     485             : The buffer's local variables (if any) will have been processed before the
     486             : functions are called."
     487             :   :group 'find-file
     488             :   :type 'hook
     489             :   :options '(auto-insert)
     490             :   :version "22.1")
     491             : 
     492             : (define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
     493             : (defvar write-file-functions nil
     494             :   "List of functions to be called before saving a buffer to a file.
     495             : Only used by `save-buffer'.
     496             : If one of them returns non-nil, the file is considered already written
     497             : and the rest are not called.
     498             : These hooks are considered to pertain to the visited file.
     499             : So any buffer-local binding of this variable is discarded if you change
     500             : the visited file name with \\[set-visited-file-name], but not when you
     501             : change the major mode.
     502             : 
     503             : This hook is not run if any of the functions in
     504             : `write-contents-functions' returns non-nil.  Both hooks pertain
     505             : to how to save a buffer to file, for instance, choosing a suitable
     506             : coding system and setting mode bits.  (See Info
     507             : node `(elisp)Saving Buffers'.)  To perform various checks or
     508             : updates before the buffer is saved, use `before-save-hook'.")
     509             : (put 'write-file-functions 'permanent-local t)
     510             : 
     511             : (defvar local-write-file-hooks nil)
     512             : (make-variable-buffer-local 'local-write-file-hooks)
     513             : (put 'local-write-file-hooks 'permanent-local t)
     514             : (make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1")
     515             : 
     516             : (define-obsolete-variable-alias 'write-contents-hooks
     517             :     'write-contents-functions "22.1")
     518             : (defvar write-contents-functions nil
     519             :   "List of functions to be called before writing out a buffer to a file.
     520             : Only used by `save-buffer'.
     521             : If one of them returns non-nil, the file is considered already written
     522             : and the rest are not called and neither are the functions in
     523             : `write-file-functions'.
     524             : 
     525             : This variable is meant to be used for hooks that pertain to the
     526             : buffer's contents, not to the particular visited file; thus,
     527             : `set-visited-file-name' does not clear this variable; but changing the
     528             : major mode does clear it.
     529             : 
     530             : For hooks that _do_ pertain to the particular visited file, use
     531             : `write-file-functions'.  Both this variable and
     532             : `write-file-functions' relate to how a buffer is saved to file.
     533             : To perform various checks or updates before the buffer is saved,
     534             : use `before-save-hook'.")
     535             : (make-variable-buffer-local 'write-contents-functions)
     536             : 
     537             : (defcustom enable-local-variables t
     538             :   "Control use of local variables in files you visit.
     539             : The value can be t, nil, :safe, :all, or something else.
     540             : 
     541             : A value of t means file local variables specifications are obeyed
     542             : if all the specified variable values are safe; if any values are
     543             : not safe, Emacs queries you, once, whether to set them all.
     544             : \(When you say yes to certain values, they are remembered as safe.)
     545             : 
     546             : :safe means set the safe variables, and ignore the rest.
     547             : :all means set all variables, whether safe or not.
     548             :  (Don't set it permanently to :all.)
     549             : A value of nil means always ignore the file local variables.
     550             : 
     551             : Any other value means always query you once whether to set them all.
     552             : \(When you say yes to certain values, they are remembered as safe, but
     553             : this has no effect when `enable-local-variables' is \"something else\".)
     554             : 
     555             : This variable also controls use of major modes specified in
     556             : a -*- line.
     557             : 
     558             : The command \\[normal-mode], when used interactively,
     559             : always obeys file local variable specifications and the -*- line,
     560             : and ignores this variable."
     561             :   :risky t
     562             :   :type '(choice (const :tag "Query Unsafe" t)
     563             :                  (const :tag "Safe Only" :safe)
     564             :                  (const :tag "Do all" :all)
     565             :                  (const :tag "Ignore" nil)
     566             :                  (other :tag "Query" other))
     567             :   :group 'find-file)
     568             : 
     569             : (defvar enable-dir-local-variables t
     570             :   "Non-nil means enable use of directory-local variables.
     571             : Some modes may wish to set this to nil to prevent directory-local
     572             : settings being applied, but still respect file-local ones.")
     573             : 
     574             : ;; This is an odd variable IMO.
     575             : ;; You might wonder why it is needed, when we could just do:
     576             : ;; (set (make-local-variable 'enable-local-variables) nil)
     577             : ;; These two are not precisely the same.
     578             : ;; Setting this variable does not cause -*- mode settings to be
     579             : ;; ignored, whereas setting enable-local-variables does.
     580             : ;; Only three places in Emacs use this variable: tar and arc modes,
     581             : ;; and rmail.  The first two don't need it.  They already use
     582             : ;; inhibit-local-variables-regexps, which is probably enough, and
     583             : ;; could also just set enable-local-variables locally to nil.
     584             : ;; Them setting it has the side-effect that dir-locals cannot apply to
     585             : ;; eg tar files (?).  FIXME Is this appropriate?
     586             : ;; AFAICS, rmail is the only thing that needs this, and the only
     587             : ;; reason it uses it is for BABYL files (which are obsolete).
     588             : ;; These contain "-*- rmail -*-" in the first line, which rmail wants
     589             : ;; to respect, so that find-file on a BABYL file will switch to
     590             : ;; rmail-mode automatically (this is nice, but hardly essential,
     591             : ;; since most people are used to explicitly running a command to
     592             : ;; access their mail; M-x gnus etc).  Rmail files may happen to
     593             : ;; contain Local Variables sections in messages, which Rmail wants to
     594             : ;; ignore.  So AFAICS the only reason this variable exists is for a
     595             : ;; minor convenience feature for handling of an obsolete Rmail file format.
     596             : (defvar local-enable-local-variables t
     597             :   "Like `enable-local-variables', except for major mode in a -*- line.
     598             : The meaningful values are nil and non-nil.  The default is non-nil.
     599             : It should be set in a buffer-local fashion.
     600             : 
     601             : Setting this to nil has the same effect as setting `enable-local-variables'
     602             : to nil, except that it does not ignore any mode: setting in a -*- line.
     603             : Unless this difference matters to you, you should set `enable-local-variables'
     604             : instead of this variable.")
     605             : 
     606             : (defcustom enable-local-eval 'maybe
     607             :   "Control processing of the \"variable\" `eval' in a file's local variables.
     608             : The value can be t, nil or something else.
     609             : A value of t means obey `eval' variables.
     610             : A value of nil means ignore them; anything else means query."
     611             :   :risky t
     612             :   :type '(choice (const :tag "Obey" t)
     613             :                  (const :tag "Ignore" nil)
     614             :                  (other :tag "Query" other))
     615             :   :group 'find-file)
     616             : 
     617             : (defcustom view-read-only nil
     618             :   "Non-nil means buffers visiting files read-only do so in view mode.
     619             : In fact, this means that all read-only buffers normally have
     620             : View mode enabled, including buffers that are read-only because
     621             : you visit a file you cannot alter, and buffers you make read-only
     622             : using \\[read-only-mode]."
     623             :   :type 'boolean
     624             :   :group 'view)
     625             : 
     626             : (defvar file-name-history nil
     627             :   "History list of file names entered in the minibuffer.
     628             : 
     629             : Maximum length of the history list is determined by the value
     630             : of `history-length', which see.")
     631             : 
     632             : (defvar save-silently nil
     633             :   "If non-nil, avoid messages when saving files.
     634             : Error-related messages will still be printed, but all other
     635             : messages will not.")
     636             : 
     637             : 
     638             : (put 'ange-ftp-completion-hook-function 'safe-magic t)
     639             : (defun ange-ftp-completion-hook-function (op &rest args)
     640             :   "Provides support for ange-ftp host name completion.
     641             : Runs the usual ange-ftp hook, but only for completion operations."
     642             :   ;; Having this here avoids the need to load ange-ftp when it's not
     643             :   ;; really in use.
     644           0 :   (if (memq op '(file-name-completion file-name-all-completions))
     645           0 :       (apply 'ange-ftp-hook-function op args)
     646           0 :     (let ((inhibit-file-name-handlers
     647           0 :            (cons 'ange-ftp-completion-hook-function
     648           0 :                  (and (eq inhibit-file-name-operation op)
     649           0 :                       inhibit-file-name-handlers)))
     650           0 :           (inhibit-file-name-operation op))
     651           0 :       (apply op args))))
     652             : 
     653             : (declare-function dos-convert-standard-filename "dos-fns.el" (filename))
     654             : (declare-function w32-convert-standard-filename "w32-fns.el" (filename))
     655             : 
     656             : (defun convert-standard-filename (filename)
     657             :   "Convert a standard file's name to something suitable for the OS.
     658             : This means to guarantee valid names and perhaps to canonicalize
     659             : certain patterns.
     660             : 
     661             : FILENAME should be an absolute file name since the conversion rules
     662             : sometimes vary depending on the position in the file name.  E.g. c:/foo
     663             : is a valid DOS file name, but c:/bar/c:/foo is not.
     664             : 
     665             : This function's standard definition is trivial; it just returns
     666             : the argument.  However, on Windows and DOS, replace invalid
     667             : characters.  On DOS, make sure to obey the 8.3 limitations.
     668             : In the native Windows build, turn Cygwin names into native names.
     669             : 
     670             : See Info node `(elisp)Standard File Names' for more details."
     671           3 :   (cond
     672           3 :    ((eq system-type 'cygwin)
     673           0 :     (let ((name (copy-sequence filename))
     674             :           (start 0))
     675             :       ;; Replace invalid filename characters with !
     676           0 :       (while (string-match "[?*:<>|\"\000-\037]" name start)
     677           0 :         (aset name (match-beginning 0) ?!)
     678           0 :         (setq start (match-end 0)))
     679           0 :       name))
     680           3 :    ((eq system-type 'windows-nt)
     681           0 :     (w32-convert-standard-filename filename))
     682           3 :    ((eq system-type 'ms-dos)
     683           0 :     (dos-convert-standard-filename filename))
     684           3 :    (t filename)))
     685             : 
     686             : (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
     687             :   "Read directory name, prompting with PROMPT and completing in directory DIR.
     688             : Value is not expanded---you must call `expand-file-name' yourself.
     689             : Default name to DEFAULT-DIRNAME if user exits with the same
     690             : non-empty string that was inserted by this function.
     691             :  (If DEFAULT-DIRNAME is omitted, DIR combined with INITIAL is used,
     692             :   or just DIR if INITIAL is nil.)
     693             : If the user exits with an empty minibuffer, this function returns
     694             : an empty string.  (This can only happen if the user erased the
     695             : pre-inserted contents or if `insert-default-directory' is nil.)
     696             : Fourth arg MUSTMATCH non-nil means require existing directory's name.
     697             :  Non-nil and non-t means also require confirmation after completion.
     698             : Fifth arg INITIAL specifies text to start with.
     699             : DIR should be an absolute directory name.  It defaults to
     700             : the value of `default-directory'."
     701           0 :   (unless dir
     702           0 :     (setq dir default-directory))
     703           0 :   (read-file-name prompt dir (or default-dirname
     704           0 :                                  (if initial (expand-file-name initial dir)
     705           0 :                                    dir))
     706           0 :                   mustmatch initial
     707           0 :                   'file-directory-p))
     708             : 
     709             : 
     710             : (defun pwd (&optional insert)
     711             :   "Show the current default directory.
     712             : With prefix argument INSERT, insert the current default directory
     713             : at point instead."
     714             :   (interactive "P")
     715           0 :   (if insert
     716           0 :       (insert default-directory)
     717           0 :     (message "Directory %s" default-directory)))
     718             : 
     719             : (defvar cd-path nil
     720             :   "Value of the CDPATH environment variable, as a list.
     721             : Not actually set up until the first time you use it.")
     722             : 
     723             : (defun parse-colon-path (search-path)
     724             :   "Explode a search path into a list of directory names.
     725             : Directories are separated by `path-separator' (which is colon in
     726             : GNU and Unix systems).  Substitute environment variables into the
     727             : resulting list of directory names.  For an empty path element (i.e.,
     728             : a leading or trailing separator, or two adjacent separators), return
     729             : nil (meaning `default-directory') as the associated list element."
     730           0 :   (when (stringp search-path)
     731           0 :     (mapcar (lambda (f)
     732           0 :               (if (equal "" f) nil
     733           0 :                 (substitute-in-file-name (file-name-as-directory f))))
     734           0 :             (split-string search-path path-separator))))
     735             : 
     736             : (defun cd-absolute (dir)
     737             :   "Change current directory to given absolute file name DIR."
     738             :   ;; Put the name into directory syntax now,
     739             :   ;; because otherwise expand-file-name may give some bad results.
     740         148 :   (setq dir (file-name-as-directory dir))
     741             :   ;; We used to additionally call abbreviate-file-name here, for an
     742             :   ;; unknown reason.  Problem is that most buffers are setup
     743             :   ;; without going through cd-absolute and don't call
     744             :   ;; abbreviate-file-name on their default-directory, so the few that
     745             :   ;; do end up using a superficially different directory.
     746         148 :   (setq dir (expand-file-name dir))
     747         148 :   (if (not (file-directory-p dir))
     748           0 :       (if (file-exists-p dir)
     749           0 :           (error "%s is not a directory" dir)
     750           0 :         (error "%s: no such directory" dir))
     751         148 :     (unless (file-accessible-directory-p dir)
     752         148 :       (error "Cannot cd to %s:  Permission denied" dir))
     753         148 :     (setq default-directory dir)
     754         148 :     (setq list-buffers-directory dir)))
     755             : 
     756             : (defun cd (dir)
     757             :   "Make DIR become the current buffer's default directory.
     758             : If your environment includes a `CDPATH' variable, try each one of
     759             : that list of directories (separated by occurrences of
     760             : `path-separator') when resolving a relative directory name.
     761             : The path separator is colon in GNU and GNU-like systems."
     762             :   (interactive
     763           0 :    (list
     764             :     ;; FIXME: There's a subtle bug in the completion below.  Seems linked
     765             :     ;; to a fundamental difficulty of implementing `predicate' correctly.
     766             :     ;; The manifestation is that TAB may list non-directories in the case where
     767             :     ;; those files also correspond to valid directories (if your cd-path is (A/
     768             :     ;; B/) and you have A/a a file and B/a a directory, then both `a' and `a/'
     769             :     ;; will be listed as valid completions).
     770             :     ;; This is because `a' (listed because of A/a) is indeed a valid choice
     771             :     ;; (which will lead to the use of B/a).
     772           0 :     (minibuffer-with-setup-hook
     773             :         (lambda ()
     774           0 :           (setq-local minibuffer-completion-table
     775           0 :                       (apply-partially #'locate-file-completion-table
     776           0 :                                        cd-path nil))
     777           0 :           (setq-local minibuffer-completion-predicate
     778             :                       (lambda (dir)
     779           0 :                         (locate-file dir cd-path nil
     780           0 :                                      (lambda (f) (and (file-directory-p f) 'dir-ok))))))
     781           0 :       (unless cd-path
     782           0 :         (setq cd-path (or (parse-colon-path (getenv "CDPATH"))
     783           0 :                           (list "./"))))
     784           0 :       (read-directory-name "Change default directory: "
     785           0 :                            default-directory default-directory
     786           0 :                            t))))
     787         148 :   (unless cd-path
     788           0 :     (setq cd-path (or (parse-colon-path (getenv "CDPATH"))
     789         148 :                       (list "./"))))
     790         148 :   (cd-absolute
     791         148 :    (or (locate-file dir cd-path nil
     792         296 :                     (lambda (f) (and (file-directory-p f) 'dir-ok)))
     793         148 :        (error "No such directory found via CDPATH environment variable"))))
     794             : 
     795             : (defun directory-files-recursively (dir regexp &optional include-directories)
     796             :   "Return list of all files under DIR that have file names matching REGEXP.
     797             : This function works recursively.  Files are returned in \"depth first\"
     798             : order, and files from each directory are sorted in alphabetical order.
     799             : Each file name appears in the returned list in its absolute form.
     800             : Optional argument INCLUDE-DIRECTORIES non-nil means also include in the
     801             : output directories whose names match REGEXP."
     802           0 :   (let ((result nil)
     803             :         (files nil)
     804             :         ;; When DIR is "/", remote file names like "/method:" could
     805             :         ;; also be offered.  We shall suppress them.
     806           0 :         (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
     807           0 :     (dolist (file (sort (file-name-all-completions "" dir)
     808           0 :                         'string<))
     809           0 :       (unless (member file '("./" "../"))
     810           0 :         (if (directory-name-p file)
     811           0 :             (let* ((leaf (substring file 0 (1- (length file))))
     812           0 :                    (full-file (expand-file-name leaf dir)))
     813             :               ;; Don't follow symlinks to other directories.
     814           0 :               (unless (file-symlink-p full-file)
     815           0 :                 (setq result
     816           0 :                       (nconc result (directory-files-recursively
     817           0 :                                      full-file regexp include-directories))))
     818           0 :               (when (and include-directories
     819           0 :                          (string-match regexp leaf))
     820           0 :                 (setq result (nconc result (list full-file)))))
     821           0 :           (when (string-match regexp file)
     822           0 :             (push (expand-file-name file dir) files)))))
     823           0 :     (nconc result (nreverse files))))
     824             : 
     825             : (defvar module-file-suffix)
     826             : 
     827             : (defun load-file (file)
     828             :   "Load the Lisp file named FILE."
     829             :   ;; This is a case where .elc and .so/.dll make a lot of sense.
     830           0 :   (interactive (list (let ((completion-ignored-extensions
     831           0 :                             (remove module-file-suffix
     832           0 :                                     (remove ".elc"
     833           0 :                                             completion-ignored-extensions))))
     834           0 :                        (read-file-name "Load file: " nil nil 'lambda))))
     835           0 :   (load (expand-file-name file) nil nil t))
     836             : 
     837             : (defun locate-file (filename path &optional suffixes predicate)
     838             :   "Search for FILENAME through PATH.
     839             : If found, return the absolute file name of FILENAME; otherwise
     840             : return nil.
     841             : PATH should be a list of directories to look in, like the lists in
     842             : `exec-path' or `load-path'.
     843             : If SUFFIXES is non-nil, it should be a list of suffixes to append to
     844             : file name when searching.  If SUFFIXES is nil, it is equivalent to (\"\").
     845             : Use (\"/\") to disable PATH search, but still try the suffixes in SUFFIXES.
     846             : If non-nil, PREDICATE is used instead of `file-readable-p'.
     847             : 
     848             : This function will normally skip directories, so if you want it to find
     849             : directories, make sure the PREDICATE function returns `dir-ok' for them.
     850             : 
     851             : PREDICATE can also be an integer to pass to the `access' system call,
     852             : in which case file-name handlers are ignored.  This usage is deprecated.
     853             : For compatibility, PREDICATE can also be one of the symbols
     854             : `executable', `readable', `writable', or `exists', or a list of
     855             : one or more of those symbols."
     856         154 :   (if (and predicate (symbolp predicate) (not (functionp predicate)))
     857         154 :       (setq predicate (list predicate)))
     858         154 :   (when (and (consp predicate) (not (functionp predicate)))
     859           0 :     (setq predicate
     860           0 :           (logior (if (memq 'executable predicate) 1 0)
     861           0 :                   (if (memq 'writable predicate) 2 0)
     862         154 :                   (if (memq 'readable predicate) 4 0))))
     863         154 :   (locate-file-internal filename path suffixes predicate))
     864             : 
     865             : (defun locate-file-completion-table (dirs suffixes string pred action)
     866             :   "Do completion for file names passed to `locate-file'."
     867           0 :   (cond
     868           0 :    ((file-name-absolute-p string)
     869             :     ;; FIXME: maybe we should use completion-file-name-table instead,
     870             :     ;; tho at least for `load', the arg is passed through
     871             :     ;; substitute-in-file-name for historical reasons.
     872           0 :     (read-file-name-internal string pred action))
     873           0 :    ((eq (car-safe action) 'boundaries)
     874           0 :     (let ((suffix (cdr action)))
     875           0 :       `(boundaries
     876           0 :         ,(length (file-name-directory string))
     877           0 :         ,@(let ((x (file-name-directory suffix)))
     878           0 :             (if x (1- (length x)) (length suffix))))))
     879             :    (t
     880           0 :     (let ((names '())
     881             :           ;; If we have files like "foo.el" and "foo.elc", we could load one of
     882             :           ;; them with "foo.el", "foo.elc", or "foo", where just "foo" is the
     883             :           ;; preferred way.  So if we list all 3, that gives a lot of redundant
     884             :           ;; entries for the poor soul looking just for "foo".  OTOH, sometimes
     885             :           ;; the user does want to pay attention to the extension.  We try to
     886             :           ;; diffuse this tension by stripping the suffix, except when the
     887             :           ;; result is a single element (i.e. usually we only list "foo" unless
     888             :           ;; it's the only remaining element in the list, in which case we do
     889             :           ;; list "foo", "foo.elc" and "foo.el").
     890             :           (fullnames '())
     891           0 :           (suffix (concat (regexp-opt suffixes t) "\\'"))
     892           0 :           (string-dir (file-name-directory string))
     893           0 :           (string-file (file-name-nondirectory string)))
     894           0 :       (dolist (dir dirs)
     895           0 :         (unless dir
     896           0 :           (setq dir default-directory))
     897           0 :         (if string-dir (setq dir (expand-file-name string-dir dir)))
     898           0 :         (when (file-directory-p dir)
     899           0 :           (dolist (file (file-name-all-completions
     900           0 :                          string-file dir))
     901           0 :             (if (not (string-match suffix file))
     902           0 :                 (push file names)
     903           0 :               (push file fullnames)
     904           0 :               (push (substring file 0 (match-beginning 0)) names)))))
     905             :       ;; Switching from names to names+fullnames creates a non-monotonicity
     906             :       ;; which can cause problems with things like partial-completion.
     907             :       ;; To minimize the problem, filter out completion-regexp-list, so that
     908             :       ;; M-x load-library RET t/x.e TAB finds some files.  Also remove elements
     909             :       ;; from `names' which only matched `string' when they still had
     910             :       ;; their suffix.
     911           0 :       (setq names (all-completions string names))
     912             :       ;; Remove duplicates of the first element, so that we can easily check
     913             :       ;; if `names' really only contains a single element.
     914           0 :       (when (cdr names) (setcdr names (delete (car names) (cdr names))))
     915           0 :       (unless (cdr names)
     916             :         ;; There's no more than one matching non-suffixed element, so expand
     917             :         ;; the list by adding the suffixed elements as well.
     918           0 :         (setq names (nconc names fullnames)))
     919           0 :       (completion-table-with-context
     920           0 :        string-dir names string-file pred action)))))
     921             : 
     922             : (defun locate-file-completion (string path-and-suffixes action)
     923             :   "Do completion for file names passed to `locate-file'.
     924             : PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
     925             :   (declare (obsolete locate-file-completion-table "23.1"))
     926           0 :   (locate-file-completion-table (car path-and-suffixes)
     927           0 :                                 (cdr path-and-suffixes)
     928           0 :                                 string nil action))
     929             : 
     930             : (defvar locate-dominating-stop-dir-regexp
     931             :   (purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'")
     932             :   "Regexp of directory names which stop the search in `locate-dominating-file'.
     933             : Any directory whose name matches this regexp will be treated like
     934             : a kind of root directory by `locate-dominating-file' which will stop its search
     935             : when it bumps into it.
     936             : The default regexp prevents fruitless and time-consuming attempts to find
     937             : special files in directories in which filenames are interpreted as hostnames,
     938             : or mount points potentially requiring authentication as a different user.")
     939             : 
     940             : ;; (defun locate-dominating-files (file regexp)
     941             : ;;   "Look up the directory hierarchy from FILE for a file matching REGEXP.
     942             : ;; Stop at the first parent where a matching file is found and return the list
     943             : ;; of files that that match in this directory."
     944             : ;;   (catch 'found
     945             : ;;     ;; `user' is not initialized yet because `file' may not exist, so we may
     946             : ;;     ;; have to walk up part of the hierarchy before we find the "initial UID".
     947             : ;;     (let ((user nil)
     948             : ;;           ;; Abbreviate, so as to stop when we cross ~/.
     949             : ;;           (dir (abbreviate-file-name (file-name-as-directory file)))
     950             : ;;           files)
     951             : ;;       (while (and dir
     952             : ;;                   ;; As a heuristic, we stop looking up the hierarchy of
     953             : ;;                   ;; directories as soon as we find a directory belonging to
     954             : ;;                   ;; another user.  This should save us from looking in
     955             : ;;                   ;; things like /net and /afs.  This assumes that all the
     956             : ;;                   ;; files inside a project belong to the same user.
     957             : ;;                   (let ((prev-user user))
     958             : ;;                     (setq user (nth 2 (file-attributes dir)))
     959             : ;;                     (or (null prev-user) (equal user prev-user))))
     960             : ;;         (if (setq files (condition-case nil
     961             : ;;                          (directory-files dir 'full regexp 'nosort)
     962             : ;;                        (error nil)))
     963             : ;;             (throw 'found files)
     964             : ;;           (if (equal dir
     965             : ;;                      (setq dir (file-name-directory
     966             : ;;                                 (directory-file-name dir))))
     967             : ;;               (setq dir nil))))
     968             : ;;       nil)))
     969             : 
     970             : (defun locate-dominating-file (file name)
     971             :   "Starting from FILE, look up directory hierarchy for directory containing NAME.
     972             : FILE can be a file or a directory.  If it's a file, its directory will
     973             : serve as the starting point for searching the hierarchy of directories.
     974             : Stop at the first parent directory containing a file NAME,
     975             : and return the directory.  Return nil if not found.
     976             : Instead of a string, NAME can also be a predicate taking one argument
     977             : \(a directory) and returning a non-nil value if that directory is the one for
     978             : which we're looking.  The predicate will be called with every file/directory
     979             : the function needs to examine, starting with FILE."
     980             :   ;; We used to use the above locate-dominating-files code, but the
     981             :   ;; directory-files call is very costly, so we're much better off doing
     982             :   ;; multiple calls using the code in here.
     983             :   ;;
     984             :   ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
     985             :   ;; `name' in /home or in /.
     986         722 :   (setq file (abbreviate-file-name (expand-file-name file)))
     987         722 :   (let ((root nil)
     988             :         ;; `user' is not initialized outside the loop because
     989             :         ;; `file' may not exist, so we may have to walk up part of the
     990             :         ;; hierarchy before we find the "initial UID".  Note: currently unused
     991             :         ;; (user nil)
     992             :         try)
     993        4780 :     (while (not (or root
     994        4483 :                     (null file)
     995             :                     ;; FIXME: Disabled this heuristic because it is sometimes
     996             :                     ;; inappropriate.
     997             :                     ;; As a heuristic, we stop looking up the hierarchy of
     998             :                     ;; directories as soon as we find a directory belonging
     999             :                     ;; to another user.  This should save us from looking in
    1000             :                     ;; things like /net and /afs.  This assumes that all the
    1001             :                     ;; files inside a project belong to the same user.
    1002             :                     ;; (let ((prev-user user))
    1003             :                     ;;   (setq user (nth 2 (file-attributes file)))
    1004             :                     ;;   (and prev-user (not (equal user prev-user))))
    1005        4780 :                     (string-match locate-dominating-stop-dir-regexp file)))
    1006        4058 :       (setq try (if (stringp name)
    1007        3666 :                     (file-exists-p (expand-file-name name file))
    1008        4058 :                   (funcall name file)))
    1009        4058 :       (cond (try (setq root file))
    1010        3761 :             ((equal file (setq file (file-name-directory
    1011        3761 :                                      (directory-file-name file))))
    1012        4058 :              (setq file nil))))
    1013         722 :     (if root (file-name-as-directory root))))
    1014             : 
    1015             : (defcustom user-emacs-directory-warning t
    1016             :   "Non-nil means warn if cannot access `user-emacs-directory'.
    1017             : Set this to nil at your own risk..."
    1018             :   :type 'boolean
    1019             :   :group 'initialization
    1020             :   :version "24.4")
    1021             : 
    1022             : (defun locate-user-emacs-file (new-name &optional old-name)
    1023             :   "Return an absolute per-user Emacs-specific file name.
    1024             : If NEW-NAME exists in `user-emacs-directory', return it.
    1025             : Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
    1026             : Else return NEW-NAME in `user-emacs-directory', creating the
    1027             : directory if it does not exist."
    1028           1 :   (convert-standard-filename
    1029           1 :    (let* ((home (concat "~" (or init-file-user "")))
    1030           1 :           (at-home (and old-name (expand-file-name old-name home)))
    1031           1 :           (bestname (abbreviate-file-name
    1032           1 :                      (expand-file-name new-name user-emacs-directory))))
    1033           1 :      (if (and at-home (not (file-readable-p bestname))
    1034           1 :               (file-readable-p at-home))
    1035           0 :          at-home
    1036             :        ;; Make sure `user-emacs-directory' exists,
    1037             :        ;; unless we're in batch mode or dumping Emacs.
    1038           1 :        (or noninteractive
    1039           0 :            purify-flag
    1040           0 :            (let (errtype)
    1041           0 :              (if (file-directory-p user-emacs-directory)
    1042           0 :                  (or (file-accessible-directory-p user-emacs-directory)
    1043           0 :                      (setq errtype "access"))
    1044           0 :                (with-file-modes ?\700
    1045           0 :                  (condition-case nil
    1046           0 :                      (make-directory user-emacs-directory)
    1047           0 :                    (error (setq errtype "create")))))
    1048           0 :              (when (and errtype
    1049           0 :                         user-emacs-directory-warning
    1050           0 :                         (not (get 'user-emacs-directory-warning 'this-session)))
    1051             :                ;; Only warn once per Emacs session.
    1052           0 :                (put 'user-emacs-directory-warning 'this-session t)
    1053           0 :                (display-warning 'initialization
    1054           0 :                                 (format "\
    1055             : Unable to %s `user-emacs-directory' (%s).
    1056             : Any data that would normally be written there may be lost!
    1057             : If you never want to see this message again,
    1058             : customize the variable `user-emacs-directory-warning'."
    1059           1 :                                         errtype user-emacs-directory)))))
    1060           1 :        bestname))))
    1061             : 
    1062             : 
    1063             : (defun executable-find (command)
    1064             :   "Search for COMMAND in `exec-path' and return the absolute file name.
    1065             : Return nil if COMMAND is not found anywhere in `exec-path'."
    1066             :   ;; Use 1 rather than file-executable-p to better match the behavior of
    1067             :   ;; call-process.
    1068           2 :   (locate-file command exec-path exec-suffixes 1))
    1069             : 
    1070             : (defun load-library (library)
    1071             :   "Load the Emacs Lisp library named LIBRARY.
    1072             : LIBRARY should be a string.
    1073             : This is an interface to the function `load'.  LIBRARY is searched
    1074             : for in `load-path', both with and without `load-suffixes' (as
    1075             : well as `load-file-rep-suffixes').
    1076             : 
    1077             : See Info node `(emacs)Lisp Libraries' for more details.
    1078             : See `load-file' for a different interface to `load'."
    1079             :   (interactive
    1080           0 :    (let (completion-ignored-extensions)
    1081           0 :      (list (completing-read "Load library: "
    1082           0 :                             (apply-partially 'locate-file-completion-table
    1083           0 :                                              load-path
    1084           0 :                                              (get-load-suffixes))))))
    1085           0 :   (load library))
    1086             : 
    1087             : (defun file-remote-p (file &optional identification connected)
    1088             :   "Test whether FILE specifies a location on a remote system.
    1089             : A file is considered remote if accessing it is likely to
    1090             : be slower or less reliable than accessing local files.
    1091             : 
    1092             : `file-remote-p' never opens a new remote connection.  It can
    1093             : only reuse a connection that is already open.
    1094             : 
    1095             : Return nil or a string identifying the remote connection
    1096             : \(ideally a prefix of FILE).  Return nil if FILE is a relative
    1097             : file name.
    1098             : 
    1099             : When IDENTIFICATION is nil, the returned string is a complete
    1100             : remote identifier: with components method, user, and host.  The
    1101             : components are those present in FILE, with defaults filled in for
    1102             : any that are missing.
    1103             : 
    1104             : IDENTIFICATION can specify which part of the identification to
    1105             : return.  IDENTIFICATION can be the symbol `method', `user',
    1106             : `host', or `localname'.  Any other value is handled like nil and
    1107             : means to return the complete identification.  The string returned
    1108             : for IDENTIFICATION `localname' can differ depending on whether
    1109             : there is an existing connection.
    1110             : 
    1111             : If CONNECTED is non-nil, return an identification only if FILE is
    1112             : located on a remote system and a connection is established to
    1113             : that remote system.
    1114             : 
    1115             : Tip: You can use this expansion of remote identifier components
    1116             :      to derive a new remote file name from an existing one.  For
    1117             :      example, if FILE is \"/sudo::/path/to/file\" then
    1118             : 
    1119             :        (concat (file-remote-p FILE) \"/bin/sh\")
    1120             : 
    1121             :      returns a remote file name for file \"/bin/sh\" that has the
    1122             :      same remote identifier as FILE but expanded; a name such as
    1123             :      \"/sudo:root@myhost:/bin/sh\"."
    1124      244218 :   (let ((handler (find-file-name-handler file 'file-remote-p)))
    1125      244218 :     (if handler
    1126       15918 :         (funcall handler 'file-remote-p file identification connected)
    1127      244218 :       nil)))
    1128             : 
    1129             : ;; Probably this entire variable should be obsolete now, in favor of
    1130             : ;; something Tramp-related (?).  It is not used in many places.
    1131             : ;; It's not clear what the best file for this to be in is, but given
    1132             : ;; it uses custom-initialize-delay, it is easier if it is preloaded
    1133             : ;; rather than autoloaded.
    1134             : (defcustom remote-shell-program
    1135             :   ;; This used to try various hard-coded places for remsh, rsh, and
    1136             :   ;; rcmd, trying to guess based on location whether "rsh" was
    1137             :   ;; "restricted shell" or "remote shell", but I don't see the point
    1138             :   ;; in this day and age.  Almost everyone will use ssh, and have
    1139             :   ;; whatever command they want to use in PATH.
    1140             :   (purecopy
    1141             :    (let ((list '("ssh" "remsh" "rcmd" "rsh")))
    1142             :      (while (and list
    1143             :                  (not (executable-find (car list)))
    1144             :                  (setq list (cdr list))))
    1145             :      (or (car list) "ssh")))
    1146             :   "Program to use to execute commands on a remote host (e.g. ssh or rsh)."
    1147             :   :version "24.3"                     ; ssh rather than rsh, etc
    1148             :   :initialize 'custom-initialize-delay
    1149             :   :group 'environment
    1150             :   :type 'file)
    1151             : 
    1152             : (defcustom remote-file-name-inhibit-cache 10
    1153             :   "Whether to use the remote file-name cache for read access.
    1154             : When nil, never expire cached values (caution)
    1155             : When t, never use the cache (safe, but may be slow)
    1156             : A number means use cached values for that amount of seconds since caching.
    1157             : 
    1158             : The attributes of remote files are cached for better performance.
    1159             : If they are changed outside of Emacs's control, the cached values
    1160             : become invalid, and must be reread.  If you are sure that nothing
    1161             : other than Emacs changes the files, you can set this variable to nil.
    1162             : 
    1163             : If a remote file is checked regularly, it might be a good idea to
    1164             : let-bind this variable to a value less than the interval between
    1165             : consecutive checks.  For example:
    1166             : 
    1167             :   (defun display-time-file-nonempty-p (file)
    1168             :     (let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
    1169             :       (and (file-exists-p file)
    1170             :            (< 0 (nth 7 (file-attributes (file-chase-links file)))))))"
    1171             :   :group 'files
    1172             :   :version "24.1"
    1173             :   :type `(choice
    1174             :           (const   :tag "Do not inhibit file name cache" nil)
    1175             :           (const   :tag "Do not use file name cache" t)
    1176             :           (integer :tag "Do not use file name cache"
    1177             :                    :format "Do not use file name cache older then %v seconds"
    1178             :                    :value 10)))
    1179             : 
    1180             : (defun file-local-name (file)
    1181             :   "Return the local name component of FILE.
    1182             : It returns a file name which can be used directly as argument of
    1183             : `process-file', `start-file-process', or `shell-command'."
    1184      159941 :   (or (file-remote-p file 'localname) file))
    1185             : 
    1186             : (defun file-local-copy (file)
    1187             :   "Copy the file FILE into a temporary file on this machine.
    1188             : Returns the name of the local copy, or nil, if FILE is directly
    1189             : accessible."
    1190             :   ;; This formerly had an optional BUFFER argument that wasn't used by
    1191             :   ;; anything.
    1192         270 :   (let ((handler (find-file-name-handler file 'file-local-copy)))
    1193         270 :     (if handler
    1194         270 :         (funcall handler 'file-local-copy file)
    1195         270 :       nil)))
    1196             : 
    1197             : (defun file-truename (filename &optional counter prev-dirs)
    1198             :   "Return the truename of FILENAME.
    1199             : If FILENAME is not absolute, first expands it against `default-directory'.
    1200             : The truename of a file name is found by chasing symbolic links
    1201             : both at the level of the file and at the level of the directories
    1202             : containing it, until no links are left at any level.
    1203             : 
    1204             : \(fn FILENAME)"  ;; Don't document the optional arguments.
    1205             :   ;; COUNTER and PREV-DIRS are only used in recursive calls.
    1206             :   ;; COUNTER can be a cons cell whose car is the count of how many
    1207             :   ;; more links to chase before getting an error.
    1208             :   ;; PREV-DIRS can be a cons cell whose car is an alist
    1209             :   ;; of truenames we've just recently computed.
    1210        6727 :   (cond ((or (string= filename "") (string= filename "~"))
    1211           0 :          (setq filename (expand-file-name filename))
    1212           0 :          (if (string= filename "")
    1213           0 :              (setq filename "/")))
    1214        6727 :         ((and (string= (substring filename 0 1) "~")
    1215        6727 :               (string-match "~[^/]*/?" filename))
    1216          11 :          (let ((first-part
    1217          11 :                 (substring filename 0 (match-end 0)))
    1218          11 :                (rest (substring filename (match-end 0))))
    1219        6727 :            (setq filename (concat (expand-file-name first-part) rest)))))
    1220             : 
    1221        6727 :   (or counter (setq counter (list 100)))
    1222        6727 :   (let (done
    1223             :         ;; For speed, remove the ange-ftp completion handler from the list.
    1224             :         ;; We know it's not needed here.
    1225             :         ;; For even more speed, do this only on the outermost call.
    1226             :         (file-name-handler-alist
    1227        6727 :          (if prev-dirs file-name-handler-alist
    1228        2378 :            (let ((tem (copy-sequence file-name-handler-alist)))
    1229        6727 :              (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
    1230        6727 :     (or prev-dirs (setq prev-dirs (list nil)))
    1231             : 
    1232             :     ;; andrewi@harlequin.co.uk - on Windows, there is an issue with
    1233             :     ;; case differences being ignored by the OS, and short "8.3 DOS"
    1234             :     ;; name aliases existing for all files.  (The short names are not
    1235             :     ;; reported by directory-files, but can be used to refer to files.)
    1236             :     ;; It seems appropriate for file-truename to resolve these issues in
    1237             :     ;; the most natural way, which on Windows is to call the function
    1238             :     ;; `w32-long-file-name' - this returns the exact name of a file as
    1239             :     ;; it is stored on disk (expanding short name aliases with the full
    1240             :     ;; name in the process).
    1241        6727 :     (if (eq system-type 'windows-nt)
    1242           0 :         (unless (string-match "[[*?]" filename)
    1243             :           ;; If filename exists, use its long name.  If it doesn't
    1244             :           ;; exist, the recursion below on the directory of filename
    1245             :           ;; will drill down until we find a directory that exists,
    1246             :           ;; and use the long name of that, with the extra
    1247             :           ;; non-existent path components concatenated.
    1248           0 :           (let ((longname (w32-long-file-name filename)))
    1249           0 :             (if longname
    1250        6727 :                 (setq filename longname)))))
    1251             : 
    1252             :     ;; If this file directly leads to a link, process that iteratively
    1253             :     ;; so that we don't use lots of stack.
    1254       13454 :     (while (not done)
    1255        6727 :       (setcar counter (1- (car counter)))
    1256        6727 :       (if (< (car counter) 0)
    1257        6727 :           (error "Apparent cycle of symbolic links for %s" filename))
    1258        6727 :       (let ((handler (find-file-name-handler filename 'file-truename)))
    1259             :         ;; For file name that has a special handler, call handler.
    1260             :         ;; This is so that ange-ftp can save time by doing a no-op.
    1261        6727 :         (if handler
    1262        1543 :             (setq filename (funcall handler 'file-truename filename)
    1263        1543 :                   done t)
    1264        5184 :           (let ((dir (or (file-name-directory filename) default-directory))
    1265             :                 target dirfile)
    1266             :             ;; Get the truename of the directory.
    1267        5184 :             (setq dirfile (directory-file-name dir))
    1268             :             ;; If these are equal, we have the (or a) root directory.
    1269        5184 :             (or (string= dir dirfile)
    1270        4349 :                 (and (file-name-case-insensitive-p dir)
    1271        4349 :                      (eq (compare-strings dir 0 nil dirfile 0 nil t) t))
    1272             :                 ;; If this is the same dir we last got the truename for,
    1273             :                 ;; save time--don't recalculate.
    1274        4349 :                 (if (assoc dir (car prev-dirs))
    1275           0 :                     (setq dir (cdr (assoc dir (car prev-dirs))))
    1276        4349 :                   (let ((old dir)
    1277        4349 :                         (new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
    1278        4349 :                     (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
    1279        5184 :                     (setq dir new))))
    1280        5184 :             (if (equal ".." (file-name-nondirectory filename))
    1281           0 :                 (setq filename
    1282           0 :                       (directory-file-name (file-name-directory (directory-file-name dir)))
    1283           0 :                       done t)
    1284        5184 :               (if (equal "." (file-name-nondirectory filename))
    1285           0 :                   (setq filename (directory-file-name dir)
    1286           0 :                         done t)
    1287             :                 ;; Put it back on the file name.
    1288        5184 :                 (setq filename (concat dir (file-name-nondirectory filename)))
    1289             :                 ;; Is the file name the name of a link?
    1290        5184 :                 (setq target (file-symlink-p filename))
    1291        5184 :                 (if target
    1292             :                     ;; Yes => chase that link, then start all over
    1293             :                     ;; since the link may point to a directory name that uses links.
    1294             :                     ;; We can't safely use expand-file-name here
    1295             :                     ;; since target might look like foo/../bar where foo
    1296             :                     ;; is itself a link.  Instead, we handle . and .. above.
    1297           0 :                     (setq filename
    1298           0 :                           (if (file-name-absolute-p target)
    1299           0 :                               target
    1300           0 :                             (concat dir target))
    1301           0 :                           done nil)
    1302             :                   ;; No, we are done!
    1303        6727 :                   (setq done t))))))))
    1304        6727 :     filename))
    1305             : 
    1306             : (defun file-chase-links (filename &optional limit)
    1307             :   "Chase links in FILENAME until a name that is not a link.
    1308             : Unlike `file-truename', this does not check whether a parent
    1309             : directory name is a symbolic link.
    1310             : If the optional argument LIMIT is a number,
    1311             : it means chase no more than that many links and then stop."
    1312           0 :   (let (tem (newname filename)
    1313             :             (count 0))
    1314           0 :     (while (and (or (null limit) (< count limit))
    1315           0 :                 (setq tem (file-symlink-p newname)))
    1316           0 :       (save-match-data
    1317           0 :         (if (and (null limit) (= count 100))
    1318           0 :             (error "Apparent cycle of symbolic links for %s" filename))
    1319             :         ;; In the context of a link, `//' doesn't mean what Emacs thinks.
    1320           0 :         (while (string-match "//+" tem)
    1321           0 :           (setq tem (replace-match "/" nil nil tem)))
    1322             :         ;; Handle `..' by hand, since it needs to work in the
    1323             :         ;; target of any directory symlink.
    1324             :         ;; This code is not quite complete; it does not handle
    1325             :         ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
    1326           0 :         (while (string-match "\\`\\.\\./" tem)
    1327           0 :           (setq tem (substring tem 3))
    1328           0 :           (setq newname (expand-file-name newname))
    1329             :           ;; Chase links in the default dir of the symlink.
    1330           0 :           (setq newname
    1331           0 :                 (file-chase-links
    1332           0 :                  (directory-file-name (file-name-directory newname))))
    1333             :           ;; Now find the parent of that dir.
    1334           0 :           (setq newname (file-name-directory newname)))
    1335           0 :         (setq newname (expand-file-name tem (file-name-directory newname)))
    1336           0 :         (setq count (1+ count))))
    1337           0 :     newname))
    1338             : 
    1339             : ;; A handy function to display file sizes in human-readable form.
    1340             : ;; See http://en.wikipedia.org/wiki/Kibibyte for the reference.
    1341             : (defun file-size-human-readable (file-size &optional flavor)
    1342             :   "Produce a string showing FILE-SIZE in human-readable form.
    1343             : 
    1344             : Optional second argument FLAVOR controls the units and the display format:
    1345             : 
    1346             :  If FLAVOR is nil or omitted, each kilobyte is 1024 bytes and the produced
    1347             :     suffixes are \"k\", \"M\", \"G\", \"T\", etc.
    1348             :  If FLAVOR is `si', each kilobyte is 1000 bytes and the produced suffixes
    1349             :     are \"k\", \"M\", \"G\", \"T\", etc.
    1350             :  If FLAVOR is `iec', each kilobyte is 1024 bytes and the produced suffixes
    1351             :     are \"KiB\", \"MiB\", \"GiB\", \"TiB\", etc."
    1352           0 :   (let ((power (if (or (null flavor) (eq flavor 'iec))
    1353             :                    1024.0
    1354           0 :                  1000.0))
    1355             :         (post-fixes
    1356             :          ;; none, kilo, mega, giga, tera, peta, exa, zetta, yotta
    1357           0 :          (list "" "k" "M" "G" "T" "P" "E" "Z" "Y")))
    1358           0 :     (while (and (>= file-size power) (cdr post-fixes))
    1359           0 :       (setq file-size (/ file-size power)
    1360           0 :             post-fixes (cdr post-fixes)))
    1361           0 :     (format (if (> (mod file-size 1.0) 0.05)
    1362             :                 "%.1f%s%s"
    1363           0 :               "%.0f%s%s")
    1364           0 :             file-size
    1365           0 :             (if (and (eq flavor 'iec) (string= (car post-fixes) "k"))
    1366             :                 "K"
    1367           0 :               (car post-fixes))
    1368           0 :             (if (eq flavor 'iec) "iB" ""))))
    1369             : 
    1370             : (defcustom mounted-file-systems
    1371             :   (if (memq system-type '(windows-nt cygwin))
    1372             :       "^//[^/]+/"
    1373             :     ;; regexp-opt.el is not dumped into emacs binary.
    1374             :     ;;(concat
    1375             :     ;; "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))))
    1376             :     "^\\(?:/\\(?:afs/\\|m\\(?:edia/\\|nt\\)\\|\\(?:ne\\|tmp_mn\\)t/\\)\\)")
    1377             :   "File systems which ought to be mounted."
    1378             :   :group 'files
    1379             :   :version "26.1"
    1380             :   :require 'regexp-opt
    1381             :   :type 'regexp)
    1382             : 
    1383             : (defun temporary-file-directory ()
    1384             :   "The directory for writing temporary files.
    1385             : In case of a remote `default-directory', this is a directory for
    1386             : temporary files on that remote host.  If such a directory does
    1387             : not exist, or `default-directory' ought to be located on a
    1388             : mounted file system (see `mounted-file-systems'), the function
    1389             : returns `default-directory'.
    1390             : For a non-remote and non-mounted `default-directory', the value of
    1391             : the variable `temporary-file-directory' is returned."
    1392           4 :   (let ((handler (find-file-name-handler
    1393           4 :                   default-directory 'temporary-file-directory)))
    1394           4 :     (if handler
    1395           4 :         (funcall handler 'temporary-file-directory)
    1396           0 :       (if (string-match mounted-file-systems default-directory)
    1397           0 :           default-directory
    1398           4 :         temporary-file-directory))))
    1399             : 
    1400             : (defun make-temp-file (prefix &optional dir-flag suffix text)
    1401             :   "Create a temporary file.
    1402             : The returned file name (created by appending some random characters at the end
    1403             : of PREFIX, and expanding against `temporary-file-directory' if necessary),
    1404             : is guaranteed to point to a newly created file.
    1405             : You can then use `write-region' to write new data into the file.
    1406             : 
    1407             : If DIR-FLAG is non-nil, create a new empty directory instead of a file.
    1408             : 
    1409             : If SUFFIX is non-nil, add that at the end of the file name.
    1410             : 
    1411             : If TEXT is a string, insert it into the new file; DIR-FLAG should be nil.
    1412             : Otherwise the file will be empty."
    1413         677 :   (let ((absolute-prefix
    1414         677 :          (if (or (zerop (length prefix)) (member prefix '("." "..")))
    1415           0 :              (concat (file-name-as-directory temporary-file-directory) prefix)
    1416         677 :            (expand-file-name prefix temporary-file-directory))))
    1417         677 :     (if (find-file-name-handler absolute-prefix 'write-region)
    1418           2 :         (files--make-magic-temp-file absolute-prefix dir-flag suffix text)
    1419         675 :       (make-temp-file-internal absolute-prefix
    1420         677 :                                (if dir-flag t) (or suffix "") text))))
    1421             : 
    1422             : (defun files--make-magic-temp-file (absolute-prefix
    1423             :                                     &optional dir-flag suffix text)
    1424             :   "Implement (make-temp-file ABSOLUTE-PREFIX DIR-FLAG SUFFIX TEXT).
    1425             : This implementation works on magic file names."
    1426             :   ;; Create temp files with strict access rights.  It's easy to
    1427             :   ;; loosen them later, whereas it's impossible to close the
    1428             :   ;; time-window of loose permissions otherwise.
    1429           2 :   (with-file-modes ?\700
    1430           2 :     (let ((contents (if (stringp text) text ""))
    1431             :           file)
    1432           2 :       (while (condition-case ()
    1433           2 :                  (progn
    1434           2 :                    (setq file (make-temp-name absolute-prefix))
    1435           2 :                    (if suffix
    1436           2 :                        (setq file (concat file suffix)))
    1437           2 :                    (if dir-flag
    1438           1 :                        (make-directory file)
    1439           2 :                      (write-region contents nil file nil 'silent nil 'excl))
    1440           2 :                    nil)
    1441           2 :                (file-already-exists t))
    1442             :         ;; the file was somehow created by someone else between
    1443             :         ;; `make-temp-name' and `write-region', let's try again.
    1444           2 :         nil)
    1445           2 :       file)))
    1446             : 
    1447             : (defun make-nearby-temp-file (prefix &optional dir-flag suffix)
    1448             :   "Create a temporary file as close as possible to `default-directory'.
    1449             : If PREFIX is a relative file name, and `default-directory' is a
    1450             : remote file name or located on a mounted file systems, the
    1451             : temporary file is created in the directory returned by the
    1452             : function `temporary-file-directory'.  Otherwise, the function
    1453             : `make-temp-file' is used.  PREFIX, DIR-FLAG and SUFFIX have the
    1454             : same meaning as in `make-temp-file'."
    1455           2 :   (let ((handler (find-file-name-handler
    1456           2 :                   default-directory 'make-nearby-temp-file)))
    1457           2 :     (if (and handler (not (file-name-absolute-p default-directory)))
    1458           0 :         (funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
    1459           2 :       (let ((temporary-file-directory (temporary-file-directory)))
    1460           2 :         (make-temp-file prefix dir-flag suffix)))))
    1461             : 
    1462             : (defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
    1463             :   "Change the encoding of FILE's name from CODING to NEW-CODING.
    1464             : The value is a new name of FILE.
    1465             : Signals a `file-already-exists' error if a file of the new name
    1466             : already exists unless optional fourth argument OK-IF-ALREADY-EXISTS
    1467             : is non-nil.  A number as fourth arg means request confirmation if
    1468             : the new name already exists.  This is what happens in interactive
    1469             : use with M-x."
    1470             :   (interactive
    1471           0 :    (let ((default-coding (or file-name-coding-system
    1472           0 :                              default-file-name-coding-system))
    1473           0 :          (filename (read-file-name "Recode filename: " nil nil t))
    1474             :          from-coding to-coding)
    1475           0 :      (if (and default-coding
    1476             :               ;; We provide the default coding only when it seems that
    1477             :               ;; the filename is correctly decoded by the default
    1478             :               ;; coding.
    1479           0 :               (let ((charsets (find-charset-string filename)))
    1480           0 :                 (and (not (memq 'eight-bit-control charsets))
    1481           0 :                      (not (memq 'eight-bit-graphic charsets)))))
    1482           0 :          (setq from-coding (read-coding-system
    1483           0 :                             (format "Recode filename %s from (default %s): "
    1484           0 :                                     filename default-coding)
    1485           0 :                             default-coding))
    1486           0 :        (setq from-coding (read-coding-system
    1487           0 :                           (format "Recode filename %s from: " filename))))
    1488             : 
    1489             :      ;; We provide the default coding only when a user is going to
    1490             :      ;; change the encoding not from the default coding.
    1491           0 :      (if (eq from-coding default-coding)
    1492           0 :          (setq to-coding (read-coding-system
    1493           0 :                           (format "Recode filename %s from %s to: "
    1494           0 :                                   filename from-coding)))
    1495           0 :        (setq to-coding (read-coding-system
    1496           0 :                         (format "Recode filename %s from %s to (default %s): "
    1497           0 :                                 filename from-coding default-coding)
    1498           0 :                         default-coding)))
    1499           0 :      (list filename from-coding to-coding)))
    1500             : 
    1501           0 :   (let* ((default-coding (or file-name-coding-system
    1502           0 :                              default-file-name-coding-system))
    1503             :          ;; FILE should have been decoded by DEFAULT-CODING.
    1504           0 :          (encoded (encode-coding-string file default-coding))
    1505           0 :          (newname (decode-coding-string encoded coding))
    1506           0 :          (new-encoded (encode-coding-string newname new-coding))
    1507             :          ;; Suppress further encoding.
    1508             :          (file-name-coding-system nil)
    1509             :          (default-file-name-coding-system nil)
    1510             :          (locale-coding-system nil))
    1511           0 :     (rename-file encoded new-encoded ok-if-already-exists)
    1512           0 :     newname))
    1513             : 
    1514             : (defcustom confirm-nonexistent-file-or-buffer 'after-completion
    1515             :   "Whether confirmation is requested before visiting a new file or buffer.
    1516             : If nil, confirmation is not requested.
    1517             : If the value is `after-completion', confirmation is only
    1518             :  requested if the user called `minibuffer-complete' right before
    1519             :  `minibuffer-complete-and-exit'.
    1520             : Any other non-nil value means to request confirmation.
    1521             : 
    1522             : This affects commands like `switch-to-buffer' and `find-file'."
    1523             :   :group 'find-file
    1524             :   :version "23.1"
    1525             :   :type '(choice (const :tag "After completion" after-completion)
    1526             :                  (const :tag "Never" nil)
    1527             :                  (other :tag "Always" t)))
    1528             : 
    1529             : (defun confirm-nonexistent-file-or-buffer ()
    1530             :   "Whether to request confirmation before visiting a new file or buffer.
    1531             : The variable `confirm-nonexistent-file-or-buffer' determines the
    1532             : return value, which may be passed as the REQUIRE-MATCH arg to
    1533             : `read-buffer' or `find-file-read-args'."
    1534           0 :   (cond ((eq confirm-nonexistent-file-or-buffer 'after-completion)
    1535             :          'confirm-after-completion)
    1536           0 :         (confirm-nonexistent-file-or-buffer
    1537             :          'confirm)
    1538           0 :         (t nil)))
    1539             : 
    1540             : (defmacro minibuffer-with-setup-hook (fun &rest body)
    1541             :   "Temporarily add FUN to `minibuffer-setup-hook' while executing BODY.
    1542             : 
    1543             : By default, FUN is prepended to `minibuffer-setup-hook'.  But if FUN is of
    1544             : the form `(:append FUN1)', FUN1 will be appended to `minibuffer-setup-hook'
    1545             : instead of prepending it.
    1546             : 
    1547             : BODY should use the minibuffer at most once.
    1548             : Recursive uses of the minibuffer are unaffected (FUN is not
    1549             : called additional times).
    1550             : 
    1551             : This macro actually adds an auxiliary function that calls FUN,
    1552             : rather than FUN itself, to `minibuffer-setup-hook'."
    1553             :   (declare (indent 1) (debug t))
    1554           5 :   (let ((hook (make-symbol "setup-hook"))
    1555           5 :         (funsym (make-symbol "fun"))
    1556             :         (append nil))
    1557           5 :     (when (eq (car-safe fun) :append)
    1558           5 :       (setq append '(t) fun (cadr fun)))
    1559           5 :     `(let ((,funsym ,fun)
    1560           5 :            ,hook)
    1561           5 :        (setq ,hook
    1562             :              (lambda ()
    1563             :                ;; Clear out this hook so it does not interfere
    1564             :                ;; with any recursive minibuffer usage.
    1565           5 :                (remove-hook 'minibuffer-setup-hook ,hook)
    1566           5 :                (funcall ,funsym)))
    1567             :        (unwind-protect
    1568             :            (progn
    1569           5 :              (add-hook 'minibuffer-setup-hook ,hook ,@append)
    1570           5 :              ,@body)
    1571           5 :          (remove-hook 'minibuffer-setup-hook ,hook)))))
    1572             : 
    1573             : (defun find-file-read-args (prompt mustmatch)
    1574           0 :   (list (read-file-name prompt nil default-directory mustmatch)
    1575           0 :         t))
    1576             : 
    1577             : (defun find-file (filename &optional wildcards)
    1578             :   "Edit file FILENAME.
    1579             : Switch to a buffer visiting file FILENAME,
    1580             : creating one if none already exists.
    1581             : Interactively, the default if you just type RET is the current directory,
    1582             : but the visited file name is available through the minibuffer history:
    1583             : type M-n to pull it into the minibuffer.
    1584             : 
    1585             : You can visit files on remote machines by specifying something
    1586             : like /ssh:SOME_REMOTE_MACHINE:FILE for the file name.  You can
    1587             : also visit local files as a different user by specifying
    1588             : /sudo::FILE for the file name.
    1589             : See the Info node `(tramp)File name Syntax' in the Tramp Info
    1590             : manual, for more about this.
    1591             : 
    1592             : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
    1593             : expand wildcards (if any) and visit multiple files.  You can
    1594             : suppress wildcard expansion by setting `find-file-wildcards' to nil.
    1595             : 
    1596             : To visit a file without any kind of conversion and without
    1597             : automatically choosing a major mode, use \\[find-file-literally]."
    1598             :   (interactive
    1599           0 :    (find-file-read-args "Find file: "
    1600           0 :                         (confirm-nonexistent-file-or-buffer)))
    1601         148 :   (let ((value (find-file-noselect filename nil nil wildcards)))
    1602         148 :     (if (listp value)
    1603           0 :         (mapcar 'pop-to-buffer-same-window (nreverse value))
    1604         148 :       (pop-to-buffer-same-window value))))
    1605             : 
    1606             : (defun find-file-other-window (filename &optional wildcards)
    1607             :   "Edit file FILENAME, in another window.
    1608             : 
    1609             : Like \\[find-file] (which see), but creates a new window or reuses
    1610             : an existing one.  See the function `display-buffer'.
    1611             : 
    1612             : Interactively, the default if you just type RET is the current directory,
    1613             : but the visited file name is available through the minibuffer history:
    1614             : type M-n to pull it into the minibuffer.
    1615             : 
    1616             : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
    1617             : expand wildcards (if any) and visit multiple files."
    1618             :   (interactive
    1619           0 :    (find-file-read-args "Find file in other window: "
    1620           0 :                         (confirm-nonexistent-file-or-buffer)))
    1621           0 :   (let ((value (find-file-noselect filename nil nil wildcards)))
    1622           0 :     (if (listp value)
    1623           0 :         (progn
    1624           0 :           (setq value (nreverse value))
    1625           0 :           (switch-to-buffer-other-window (car value))
    1626           0 :           (mapc 'switch-to-buffer (cdr value))
    1627           0 :           value)
    1628           0 :       (switch-to-buffer-other-window value))))
    1629             : 
    1630             : (defun find-file-other-frame (filename &optional wildcards)
    1631             :   "Edit file FILENAME, in another frame.
    1632             : 
    1633             : Like \\[find-file] (which see), but creates a new frame or reuses
    1634             : an existing one.  See the function `display-buffer'.
    1635             : 
    1636             : Interactively, the default if you just type RET is the current directory,
    1637             : but the visited file name is available through the minibuffer history:
    1638             : type M-n to pull it into the minibuffer.
    1639             : 
    1640             : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
    1641             : expand wildcards (if any) and visit multiple files."
    1642             :   (interactive
    1643           0 :    (find-file-read-args "Find file in other frame: "
    1644           0 :                         (confirm-nonexistent-file-or-buffer)))
    1645           0 :   (let ((value (find-file-noselect filename nil nil wildcards)))
    1646           0 :     (if (listp value)
    1647           0 :         (progn
    1648           0 :           (setq value (nreverse value))
    1649           0 :           (switch-to-buffer-other-frame (car value))
    1650           0 :           (mapc 'switch-to-buffer (cdr value))
    1651           0 :           value)
    1652           0 :       (switch-to-buffer-other-frame value))))
    1653             : 
    1654             : (defun find-file-existing (filename)
    1655             :    "Edit the existing file FILENAME.
    1656             : Like \\[find-file], but only allow a file that exists, and do not allow
    1657             : file names with wildcards."
    1658           0 :    (interactive (nbutlast (find-file-read-args "Find existing file: " t)))
    1659           0 :    (if (and (not (called-interactively-p 'interactive))
    1660           0 :             (not (file-exists-p filename)))
    1661           0 :        (error "%s does not exist" filename)
    1662           0 :      (find-file filename)
    1663           0 :      (current-buffer)))
    1664             : 
    1665             : (defun find-file--read-only (fun filename wildcards)
    1666           0 :   (unless (or (and wildcards find-file-wildcards
    1667           0 :                    (not (file-name-quoted-p filename))
    1668           0 :                    (string-match "[[*?]" filename))
    1669           0 :               (file-exists-p filename))
    1670           0 :     (error "%s does not exist" filename))
    1671           0 :   (let ((value (funcall fun filename wildcards)))
    1672           0 :     (mapc (lambda (b) (with-current-buffer b (read-only-mode 1)))
    1673           0 :           (if (listp value) value (list value)))
    1674           0 :     value))
    1675             : 
    1676             : (defun find-file-read-only (filename &optional wildcards)
    1677             :   "Edit file FILENAME but don't allow changes.
    1678             : Like \\[find-file], but marks buffer as read-only.
    1679             : Use \\[read-only-mode] to permit editing."
    1680             :   (interactive
    1681           0 :    (find-file-read-args "Find file read-only: "
    1682           0 :                         (confirm-nonexistent-file-or-buffer)))
    1683           0 :   (find-file--read-only #'find-file filename wildcards))
    1684             : 
    1685             : (defun find-file-read-only-other-window (filename &optional wildcards)
    1686             :   "Edit file FILENAME in another window but don't allow changes.
    1687             : Like \\[find-file-other-window], but marks buffer as read-only.
    1688             : Use \\[read-only-mode] to permit editing."
    1689             :   (interactive
    1690           0 :    (find-file-read-args "Find file read-only other window: "
    1691           0 :                         (confirm-nonexistent-file-or-buffer)))
    1692           0 :   (find-file--read-only #'find-file-other-window filename wildcards))
    1693             : 
    1694             : (defun find-file-read-only-other-frame (filename &optional wildcards)
    1695             :   "Edit file FILENAME in another frame but don't allow changes.
    1696             : Like \\[find-file-other-frame], but marks buffer as read-only.
    1697             : Use \\[read-only-mode] to permit editing."
    1698             :   (interactive
    1699           0 :    (find-file-read-args "Find file read-only other frame: "
    1700           0 :                         (confirm-nonexistent-file-or-buffer)))
    1701           0 :   (find-file--read-only #'find-file-other-frame filename wildcards))
    1702             : 
    1703             : (defun find-alternate-file-other-window (filename &optional wildcards)
    1704             :   "Find file FILENAME as a replacement for the file in the next window.
    1705             : This command does not select that window.
    1706             : 
    1707             : See \\[find-file] for the possible forms of the FILENAME argument.
    1708             : 
    1709             : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
    1710             : expand wildcards (if any) and replace the file with multiple files."
    1711             :   (interactive
    1712           0 :    (save-selected-window
    1713           0 :      (other-window 1)
    1714           0 :      (let ((file buffer-file-name)
    1715             :            (file-name nil)
    1716             :            (file-dir nil))
    1717           0 :        (and file
    1718           0 :             (setq file-name (file-name-nondirectory file)
    1719           0 :                   file-dir (file-name-directory file)))
    1720           0 :        (list (read-file-name
    1721           0 :               "Find alternate file: " file-dir nil
    1722           0 :               (confirm-nonexistent-file-or-buffer) file-name)
    1723           0 :              t))))
    1724           0 :   (if (one-window-p)
    1725           0 :       (find-file-other-window filename wildcards)
    1726           0 :     (save-selected-window
    1727           0 :       (other-window 1)
    1728           0 :       (find-alternate-file filename wildcards))))
    1729             : 
    1730             : ;; Defined and used in buffer.c, but not as a DEFVAR_LISP.
    1731             : (defvar kill-buffer-hook nil
    1732             :   "Hook run when a buffer is killed.
    1733             : The buffer being killed is current while the hook is running.
    1734             : See `kill-buffer'.
    1735             : 
    1736             : Note: Be careful with let-binding this hook considering it is
    1737             : frequently used for cleanup.")
    1738             : 
    1739             : (defun find-alternate-file (filename &optional wildcards)
    1740             :   "Find file FILENAME, select its buffer, kill previous buffer.
    1741             : If the current buffer now contains an empty file that you just visited
    1742             : \(presumably by mistake), use this command to visit the file you really want.
    1743             : 
    1744             : See \\[find-file] for the possible forms of the FILENAME argument.
    1745             : 
    1746             : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
    1747             : expand wildcards (if any) and replace the file with multiple files.
    1748             : 
    1749             : If the current buffer is an indirect buffer, or the base buffer
    1750             : for one or more indirect buffers, the other buffer(s) are not
    1751             : killed."
    1752             :   (interactive
    1753           0 :    (let ((file buffer-file-name)
    1754             :          (file-name nil)
    1755             :          (file-dir nil))
    1756           0 :      (and file
    1757           0 :           (setq file-name (file-name-nondirectory file)
    1758           0 :                 file-dir (file-name-directory file)))
    1759           0 :      (list (read-file-name
    1760           0 :             "Find alternate file: " file-dir nil
    1761           0 :             (confirm-nonexistent-file-or-buffer) file-name)
    1762           0 :            t)))
    1763           0 :   (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
    1764           0 :     (user-error "Aborted"))
    1765           0 :   (and (buffer-modified-p) buffer-file-name
    1766           0 :        (not (yes-or-no-p
    1767           0 :              (format-message "Kill and replace buffer `%s' without saving it? "
    1768           0 :                              (buffer-name))))
    1769           0 :        (user-error "Aborted"))
    1770           0 :   (let ((obuf (current-buffer))
    1771           0 :         (ofile buffer-file-name)
    1772           0 :         (onum buffer-file-number)
    1773           0 :         (odir dired-directory)
    1774           0 :         (otrue buffer-file-truename)
    1775           0 :         (oname (buffer-name)))
    1776             :     ;; Run `kill-buffer-hook' here.  It needs to happen before
    1777             :     ;; variables like `buffer-file-name' etc are set to nil below,
    1778             :     ;; because some of the hooks that could be invoked
    1779             :     ;; (e.g., `save-place-to-alist') depend on those variables.
    1780             :     ;;
    1781             :     ;; Note that `kill-buffer-hook' is not what queries whether to
    1782             :     ;; save a modified buffer visiting a file.  Rather, `kill-buffer'
    1783             :     ;; asks that itself.  Thus, there's no need to temporarily do
    1784             :     ;; `(set-buffer-modified-p nil)' before running this hook.
    1785           0 :     (run-hooks 'kill-buffer-hook)
    1786             :     ;; Okay, now we can end-of-life the old buffer.
    1787           0 :     (if (get-buffer " **lose**")
    1788           0 :         (kill-buffer " **lose**"))
    1789           0 :     (rename-buffer " **lose**")
    1790           0 :     (unwind-protect
    1791           0 :         (progn
    1792           0 :           (unlock-buffer)
    1793             :           ;; This prevents us from finding the same buffer
    1794             :           ;; if we specified the same file again.
    1795           0 :           (setq buffer-file-name nil)
    1796           0 :           (setq buffer-file-number nil)
    1797           0 :           (setq buffer-file-truename nil)
    1798             :           ;; Likewise for dired buffers.
    1799           0 :           (setq dired-directory nil)
    1800           0 :           (find-file filename wildcards))
    1801           0 :       (when (eq obuf (current-buffer))
    1802             :         ;; This executes if find-file gets an error
    1803             :         ;; and does not really find anything.
    1804             :         ;; We put things back as they were.
    1805             :         ;; If find-file actually finds something, we kill obuf below.
    1806           0 :         (setq buffer-file-name ofile)
    1807           0 :         (setq buffer-file-number onum)
    1808           0 :         (setq buffer-file-truename otrue)
    1809           0 :         (setq dired-directory odir)
    1810           0 :         (lock-buffer)
    1811           0 :         (rename-buffer oname)))
    1812           0 :     (unless (eq (current-buffer) obuf)
    1813           0 :       (with-current-buffer obuf
    1814             :         ;; We already ran these; don't run them again.
    1815           0 :         (let (kill-buffer-query-functions kill-buffer-hook)
    1816           0 :           (kill-buffer obuf))))))
    1817             : 
    1818             : ;; FIXME we really need to fold the uniquify stuff in here by default,
    1819             : ;; not using advice, and add it to the doc string.
    1820             : (defun create-file-buffer (filename)
    1821             :   "Create a suitably named buffer for visiting FILENAME, and return it.
    1822             : FILENAME (sans directory) is used unchanged if that name is free;
    1823             : otherwise a string <2> or <3> or ... is appended to get an unused name.
    1824             : 
    1825             : Emacs treats buffers whose names begin with a space as internal buffers.
    1826             : To avoid confusion when visiting a file whose name begins with a space,
    1827             : this function prepends a \"|\" to the final result if necessary."
    1828         154 :   (let ((lastname (file-name-nondirectory filename)))
    1829         154 :     (if (string= lastname "")
    1830         154 :         (setq lastname filename))
    1831         154 :     (generate-new-buffer (if (string-match-p "\\` " lastname)
    1832           0 :                              (concat "|" lastname)
    1833         154 :                            lastname))))
    1834             : 
    1835             : (defun generate-new-buffer (name)
    1836             :   "Create and return a buffer with a name based on NAME.
    1837             : Choose the buffer's name using `generate-new-buffer-name'."
    1838        1666 :   (get-buffer-create (generate-new-buffer-name name)))
    1839             : 
    1840             : (defcustom automount-dir-prefix (purecopy "^/tmp_mnt/")
    1841             :   "Regexp to match the automounter prefix in a directory name."
    1842             :   :group 'files
    1843             :   :type 'regexp)
    1844             : (make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3")
    1845             : 
    1846             : (defvar abbreviated-home-dir nil
    1847             :   "Regexp matching the user's homedir at the beginning of file name.
    1848             : The value includes abbreviation according to `directory-abbrev-alist'.")
    1849             : 
    1850             : (defun abbreviate-file-name (filename)
    1851             :   "Return a version of FILENAME shortened using `directory-abbrev-alist'.
    1852             : This also substitutes \"~\" for the user's home directory (unless the
    1853             : home directory is a root directory) and removes automounter prefixes
    1854             : \(see the variable `automount-dir-prefix')."
    1855             :   ;; Get rid of the prefixes added by the automounter.
    1856        1471 :   (save-match-data
    1857        1471 :     (if (and automount-dir-prefix
    1858        1471 :              (string-match automount-dir-prefix filename)
    1859           0 :              (file-exists-p (file-name-directory
    1860        1471 :                              (substring filename (1- (match-end 0))))))
    1861        1471 :         (setq filename (substring filename (1- (match-end 0)))))
    1862             :     ;; Avoid treating /home/foo as /home/Foo during `~' substitution.
    1863        1471 :     (let ((case-fold-search (file-name-case-insensitive-p filename)))
    1864             :       ;; If any elt of directory-abbrev-alist matches this name,
    1865             :       ;; abbreviate accordingly.
    1866        1471 :       (dolist (dir-abbrev directory-abbrev-alist)
    1867           0 :         (if (string-match (car dir-abbrev) filename)
    1868           0 :             (setq filename
    1869           0 :                   (concat (cdr dir-abbrev)
    1870        1471 :                           (substring filename (match-end 0))))))
    1871             :       ;; Compute and save the abbreviated homedir name.
    1872             :       ;; We defer computing this until the first time it's needed, to
    1873             :       ;; give time for directory-abbrev-alist to be set properly.
    1874             :       ;; We include a slash at the end, to avoid spurious matches
    1875             :       ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
    1876        1471 :       (or abbreviated-home-dir
    1877           0 :           (setq abbreviated-home-dir
    1878           0 :                 (let ((abbreviated-home-dir "$foo"))
    1879           0 :                   (setq abbreviated-home-dir
    1880           0 :                         (concat "\\`"
    1881           0 :                                 (abbreviate-file-name (expand-file-name "~"))
    1882           0 :                                 "\\(/\\|\\'\\)"))
    1883             :                   ;; Depending on whether default-directory does or
    1884             :                   ;; doesn't include non-ASCII characters, the value
    1885             :                   ;; of abbreviated-home-dir could be multibyte or
    1886             :                   ;; unibyte.  In the latter case, we need to decode
    1887             :                   ;; it.  Note that this function is called for the
    1888             :                   ;; first time (from startup.el) when
    1889             :                   ;; locale-coding-system is already set up.
    1890           0 :                   (if (multibyte-string-p abbreviated-home-dir)
    1891           0 :                       abbreviated-home-dir
    1892           0 :                     (decode-coding-string abbreviated-home-dir
    1893           0 :                                           (if (eq system-type 'windows-nt)
    1894             :                                               'utf-8
    1895        1471 :                                             locale-coding-system))))))
    1896             : 
    1897             :       ;; If FILENAME starts with the abbreviated homedir,
    1898             :       ;; make it start with `~' instead.
    1899        1471 :       (if (and (string-match abbreviated-home-dir filename)
    1900             :                ;; If the home dir is just /, don't change it.
    1901           1 :                (not (and (= (match-end 0) 1)
    1902           1 :                          (= (aref filename 0) ?/)))
    1903             :                ;; MS-DOS root directories can come with a drive letter;
    1904             :                ;; Novell Netware allows drive letters beyond `Z:'.
    1905           1 :                (not (and (memq system-type '(ms-dos windows-nt cygwin))
    1906           0 :                          (save-match-data
    1907        1471 :                            (string-match "^[a-zA-`]:/$" filename)))))
    1908           1 :           (setq filename
    1909           1 :                 (concat "~"
    1910           1 :                         (match-string 1 filename)
    1911        1471 :                         (substring filename (match-end 0)))))
    1912        1471 :       filename)))
    1913             : 
    1914             : (defun find-buffer-visiting (filename &optional predicate)
    1915             :   "Return the buffer visiting file FILENAME (a string).
    1916             : This is like `get-file-buffer', except that it checks for any buffer
    1917             : visiting the same file, possibly under a different name.
    1918             : If PREDICATE is non-nil, only buffers satisfying it are eligible,
    1919             : and others are ignored.
    1920             : If there is no such live buffer, return nil."
    1921         148 :   (let ((predicate (or predicate #'identity))
    1922         148 :         (truename (abbreviate-file-name (file-truename filename))))
    1923         148 :     (or (let ((buf (get-file-buffer filename)))
    1924         148 :           (when (and buf (funcall predicate buf)) buf))
    1925         148 :         (let ((list (buffer-list)) found)
    1926       17578 :           (while (and (not found) list)
    1927       17430 :             (with-current-buffer (car list)
    1928       17430 :               (if (and buffer-file-name
    1929       16650 :                        (string= buffer-file-truename truename)
    1930       17430 :                        (funcall predicate (current-buffer)))
    1931       17430 :                   (setq found (car list))))
    1932       17430 :             (setq list (cdr list)))
    1933         148 :           found)
    1934         148 :         (let* ((attributes (file-attributes truename))
    1935         148 :                (number (nthcdr 10 attributes))
    1936         148 :                (list (buffer-list)) found)
    1937         148 :           (and buffer-file-numbers-unique
    1938         148 :                (car-safe number)       ;Make sure the inode is not just nil.
    1939       17578 :                (while (and (not found) list)
    1940       17430 :                  (with-current-buffer (car list)
    1941       17430 :                    (if (and buffer-file-name
    1942       16650 :                             (equal buffer-file-number number)
    1943             :                             ;; Verify this buffer's file number
    1944             :                             ;; still belongs to its file.
    1945           0 :                             (file-exists-p buffer-file-name)
    1946           0 :                             (equal (file-attributes buffer-file-truename)
    1947           0 :                                    attributes)
    1948       17430 :                             (funcall predicate (current-buffer)))
    1949       17430 :                        (setq found (car list))))
    1950       17430 :                  (setq list (cdr list))))
    1951         148 :           found))))
    1952             : 
    1953             : (defcustom find-file-wildcards t
    1954             :   "Non-nil means file-visiting commands should handle wildcards.
    1955             : For example, if you specify `*.c', that would visit all the files
    1956             : whose names match the pattern."
    1957             :   :group 'files
    1958             :   :version "20.4"
    1959             :   :type 'boolean)
    1960             : 
    1961             : (defcustom find-file-suppress-same-file-warnings nil
    1962             :   "Non-nil means suppress warning messages for symlinked files.
    1963             : When nil, Emacs prints a warning when visiting a file that is already
    1964             : visited, but with a different name.  Setting this option to t
    1965             : suppresses this warning."
    1966             :   :group 'files
    1967             :   :version "21.1"
    1968             :   :type 'boolean)
    1969             : 
    1970             : (defcustom large-file-warning-threshold 10000000
    1971             :   "Maximum size of file above which a confirmation is requested.
    1972             : When nil, never request confirmation."
    1973             :   :group 'files
    1974             :   :group 'find-file
    1975             :   :version "22.1"
    1976             :   :type '(choice integer (const :tag "Never request confirmation" nil)))
    1977             : 
    1978             : (defcustom out-of-memory-warning-percentage nil
    1979             :   "Warn if file size exceeds this percentage of available free memory.
    1980             : When nil, never issue warning.  Beware: This probably doesn't do what you
    1981             : think it does, because \"free\" is pretty hard to define in practice."
    1982             :   :group 'files
    1983             :   :group 'find-file
    1984             :   :version "25.1"
    1985             :   :type '(choice integer (const :tag "Never issue warning" nil)))
    1986             : 
    1987             : (defun abort-if-file-too-large (size op-type filename)
    1988             :   "If file SIZE larger than `large-file-warning-threshold', allow user to abort.
    1989             : OP-TYPE specifies the file operation being performed (for message to user)."
    1990         316 :   (when (and large-file-warning-threshold size
    1991         316 :              (> size large-file-warning-threshold)
    1992           0 :              (not (y-or-n-p (format "File %s is large (%s), really %s? "
    1993           0 :                                     (file-name-nondirectory filename)
    1994         316 :                                     (file-size-human-readable size) op-type))))
    1995         316 :     (user-error "Aborted")))
    1996             : 
    1997             : (defun warn-maybe-out-of-memory (size)
    1998             :   "Warn if an attempt to open file of SIZE bytes may run out of memory."
    1999         148 :   (when (and (numberp size) (not (zerop size))
    2000         148 :              (integerp out-of-memory-warning-percentage))
    2001           0 :     (let ((meminfo (memory-info)))
    2002           0 :       (when (consp meminfo)
    2003           0 :         (let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo)))))
    2004           0 :           (when (> (/ size 1024)
    2005           0 :                    (/ (* total-free-memory out-of-memory-warning-percentage)
    2006           0 :                       100.0))
    2007           0 :             (warn
    2008             :              "You are trying to open a file whose size (%s)
    2009             : exceeds the %S%% of currently available free memory (%s).
    2010             : If that fails, try to open it with `find-file-literally'
    2011             : \(but note that some characters might be displayed incorrectly)."
    2012           0 :              (file-size-human-readable size)
    2013           0 :              out-of-memory-warning-percentage
    2014         148 :              (file-size-human-readable (* total-free-memory 1024)))))))))
    2015             : 
    2016             : (defun files--message (format &rest args)
    2017             :   "Like `message', except sometimes don't print to minibuffer.
    2018             : If the variable `save-silently' is non-nil, the message is not
    2019             : displayed on the minibuffer."
    2020           0 :   (apply #'message format args)
    2021           0 :   (when save-silently (message nil)))
    2022             : 
    2023             : (defun find-file-noselect (filename &optional nowarn rawfile wildcards)
    2024             :   "Read file FILENAME into a buffer and return the buffer.
    2025             : If a buffer exists visiting FILENAME, return that one, but
    2026             : verify that the file has not changed since visited or saved.
    2027             : The buffer is not selected, just returned to the caller.
    2028             : Optional second arg NOWARN non-nil means suppress any warning messages.
    2029             : Optional third arg RAWFILE non-nil means the file is read literally.
    2030             : Optional fourth arg WILDCARDS non-nil means do wildcard processing
    2031             : and visit all the matching files.  When wildcards are actually
    2032             : used and expanded, return a list of buffers that are visiting
    2033             : the various files."
    2034         297 :   (setq filename
    2035         297 :         (abbreviate-file-name
    2036         297 :          (expand-file-name filename)))
    2037         297 :   (if (file-directory-p filename)
    2038           0 :       (or (and find-file-run-dired
    2039           0 :                (run-hook-with-args-until-success
    2040             :                 'find-directory-functions
    2041           0 :                 (if find-file-visit-truename
    2042           0 :                     (abbreviate-file-name (file-truename filename))
    2043           0 :                   filename)))
    2044           0 :           (error "%s is a directory" filename))
    2045         297 :     (if (and wildcards
    2046           0 :              find-file-wildcards
    2047           0 :              (not (file-name-quoted-p filename))
    2048         297 :              (string-match "[[*?]" filename))
    2049           0 :         (let ((files (condition-case nil
    2050           0 :                          (file-expand-wildcards filename t)
    2051           0 :                        (error (list filename))))
    2052             :               (find-file-wildcards nil))
    2053           0 :           (if (null files)
    2054           0 :               (find-file-noselect filename)
    2055           0 :             (mapcar #'find-file-noselect files)))
    2056         297 :       (let* ((buf (get-file-buffer filename))
    2057         297 :              (truename (abbreviate-file-name (file-truename filename)))
    2058         297 :              (attributes (file-attributes truename))
    2059         297 :              (number (nthcdr 10 attributes))
    2060             :              ;; Find any buffer for a file which has same truename.
    2061         297 :              (other (and (not buf) (find-buffer-visiting filename))))
    2062             :         ;; Let user know if there is a buffer with the same truename.
    2063         297 :         (if other
    2064           0 :             (progn
    2065           0 :               (or nowarn
    2066           0 :                   find-file-suppress-same-file-warnings
    2067           0 :                   (string-equal filename (buffer-file-name other))
    2068           0 :                   (files--message "%s and %s are the same file"
    2069           0 :                                   filename (buffer-file-name other)))
    2070             :               ;; Optionally also find that buffer.
    2071           0 :               (if (or find-file-existing-other-name find-file-visit-truename)
    2072         297 :                   (setq buf other))))
    2073             :         ;; Check to see if the file looks uncommonly large.
    2074         297 :         (when (not (or buf nowarn))
    2075         148 :           (abort-if-file-too-large (nth 7 attributes) "open" filename)
    2076         297 :           (warn-maybe-out-of-memory (nth 7 attributes)))
    2077         297 :         (if buf
    2078             :             ;; We are using an existing buffer.
    2079         149 :             (let (nonexistent)
    2080         149 :               (or nowarn
    2081         149 :                   (verify-visited-file-modtime buf)
    2082           0 :                   (cond ((not (file-exists-p filename))
    2083           0 :                          (setq nonexistent t)
    2084           0 :                          (message "File %s no longer exists!" filename))
    2085             :                         ;; Certain files should be reverted automatically
    2086             :                         ;; if they have changed on disk and not in the buffer.
    2087           0 :                         ((and (not (buffer-modified-p buf))
    2088           0 :                               (let ((tail revert-without-query)
    2089             :                                     (found nil))
    2090           0 :                                 (while tail
    2091           0 :                                   (if (string-match (car tail) filename)
    2092           0 :                                       (setq found t))
    2093           0 :                                   (setq tail (cdr tail)))
    2094           0 :                                 found))
    2095           0 :                          (with-current-buffer buf
    2096           0 :                            (message "Reverting file %s..." filename)
    2097           0 :                            (revert-buffer t t)
    2098           0 :                            (message "Reverting file %s...done" filename)))
    2099           0 :                         ((yes-or-no-p
    2100           0 :                           (if (string= (file-name-nondirectory filename)
    2101           0 :                                        (buffer-name buf))
    2102           0 :                               (format
    2103           0 :                                (if (buffer-modified-p buf)
    2104             :                                    "File %s changed on disk.  Discard your edits? "
    2105           0 :                                  "File %s changed on disk.  Reread from disk? ")
    2106           0 :                                (file-name-nondirectory filename))
    2107           0 :                             (format
    2108           0 :                              (if (buffer-modified-p buf)
    2109             :                                  "File %s changed on disk.  Discard your edits in %s? "
    2110           0 :                                "File %s changed on disk.  Reread from disk into %s? ")
    2111           0 :                              (file-name-nondirectory filename)
    2112           0 :                              (buffer-name buf))))
    2113           0 :                          (with-current-buffer buf
    2114         149 :                            (revert-buffer t t)))))
    2115         149 :               (with-current-buffer buf
    2116             : 
    2117             :                 ;; Check if a formerly read-only file has become
    2118             :                 ;; writable and vice versa, but if the buffer agrees
    2119             :                 ;; with the new state of the file, that is ok too.
    2120         149 :                 (let ((read-only (not (file-writable-p buffer-file-name))))
    2121         149 :                   (unless (or nonexistent
    2122         149 :                               (eq read-only buffer-file-read-only)
    2123         149 :                               (eq read-only buffer-read-only))
    2124           0 :                     (when (or nowarn
    2125           0 :                               (let* ((new-status
    2126           0 :                                       (if read-only "read-only" "writable"))
    2127             :                                      (question
    2128           0 :                                       (format "File %s is %s on disk.  Make buffer %s, too? "
    2129           0 :                                               buffer-file-name
    2130           0 :                                               new-status new-status)))
    2131           0 :                                 (y-or-n-p question)))
    2132         149 :                       (setq buffer-read-only read-only)))
    2133         149 :                   (setq buffer-file-read-only read-only))
    2134             : 
    2135         149 :                 (unless (or (eq (null rawfile) (null find-file-literally))
    2136           0 :                             nonexistent
    2137             :                             ;; It is confusing to ask whether to visit
    2138             :                             ;; non-literally if they have the file in
    2139             :                             ;; hexl-mode or image-mode.
    2140         149 :                             (memq major-mode '(hexl-mode image-mode)))
    2141           0 :                   (if (buffer-modified-p)
    2142           0 :                       (if (y-or-n-p
    2143           0 :                            (format
    2144           0 :                             (if rawfile
    2145             :                                 "The file %s is already visited normally,
    2146             : and you have edited the buffer.  Now you have asked to visit it literally,
    2147             : meaning no coding system handling, format conversion, or local variables.
    2148             : Emacs can only visit a file in one way at a time.
    2149             : 
    2150             : Do you want to save the file, and visit it literally instead? "
    2151             :                                 "The file %s is already visited literally,
    2152             : meaning no coding system handling, format conversion, or local variables.
    2153             : You have edited the buffer.  Now you have asked to visit the file normally,
    2154             : but Emacs can only visit a file in one way at a time.
    2155             : 
    2156           0 : Do you want to save the file, and visit it normally instead? ")
    2157           0 :                             (file-name-nondirectory filename)))
    2158           0 :                           (progn
    2159           0 :                             (save-buffer)
    2160           0 :                             (find-file-noselect-1 buf filename nowarn
    2161           0 :                                                   rawfile truename number))
    2162           0 :                         (if (y-or-n-p
    2163           0 :                              (format
    2164           0 :                               (if rawfile
    2165             :                                   "\
    2166             : Do you want to discard your changes, and visit the file literally now? "
    2167             :                                 "\
    2168           0 : Do you want to discard your changes, and visit the file normally now? ")))
    2169           0 :                             (find-file-noselect-1 buf filename nowarn
    2170           0 :                                                   rawfile truename number)
    2171           0 :                           (error (if rawfile "File already visited non-literally"
    2172           0 :                                    "File already visited literally"))))
    2173           0 :                     (if (y-or-n-p
    2174           0 :                          (format
    2175           0 :                           (if rawfile
    2176             :                               "The file %s is already visited normally.
    2177             : You have asked to visit it literally,
    2178             : meaning no coding system decoding, format conversion, or local variables.
    2179             : But Emacs can only visit a file in one way at a time.
    2180             : 
    2181             : Do you want to revisit the file literally now? "
    2182             :                             "The file %s is already visited literally,
    2183             : meaning no coding system decoding, format conversion, or local variables.
    2184             : You have asked to visit it normally,
    2185             : but Emacs can only visit a file in one way at a time.
    2186             : 
    2187           0 : Do you want to revisit the file normally now? ")
    2188           0 :                           (file-name-nondirectory filename)))
    2189           0 :                         (find-file-noselect-1 buf filename nowarn
    2190           0 :                                               rawfile truename number)
    2191           0 :                       (error (if rawfile "File already visited non-literally"
    2192         149 :                                "File already visited literally"))))))
    2193             :               ;; Return the buffer we are using.
    2194         149 :               buf)
    2195             :           ;; Create a new buffer.
    2196         148 :           (setq buf (create-file-buffer filename))
    2197             :           ;; find-file-noselect-1 may use a different buffer.
    2198         148 :           (find-file-noselect-1 buf filename nowarn
    2199         297 :                                 rawfile truename number))))))
    2200             : 
    2201             : (defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
    2202         148 :   (let (error)
    2203         148 :     (with-current-buffer buf
    2204         148 :       (kill-local-variable 'find-file-literally)
    2205             :       ;; Needed in case we are re-visiting the file with a different
    2206             :       ;; text representation.
    2207         148 :       (kill-local-variable 'buffer-file-coding-system)
    2208         148 :       (kill-local-variable 'cursor-type)
    2209         148 :       (let ((inhibit-read-only t))
    2210         148 :         (erase-buffer))
    2211         148 :       (and (default-value 'enable-multibyte-characters)
    2212         148 :            (not rawfile)
    2213         148 :            (set-buffer-multibyte t))
    2214         148 :       (if rawfile
    2215           0 :           (condition-case ()
    2216           0 :               (let ((inhibit-read-only t))
    2217           0 :                 (insert-file-contents-literally filename t))
    2218             :             (file-error
    2219           0 :              (when (and (file-exists-p filename)
    2220           0 :                         (not (file-readable-p filename)))
    2221           0 :                (kill-buffer buf)
    2222           0 :                (signal 'file-error (list "File is not readable"
    2223           0 :                                          filename)))
    2224             :              ;; Unconditionally set error
    2225           0 :              (setq error t)))
    2226         148 :         (condition-case ()
    2227         148 :             (let ((inhibit-read-only t))
    2228         148 :               (insert-file-contents filename t))
    2229             :           (file-error
    2230           0 :            (when (and (file-exists-p filename)
    2231           0 :                       (not (file-readable-p filename)))
    2232           0 :              (kill-buffer buf)
    2233           0 :              (signal 'file-error (list "File is not readable"
    2234           0 :                                        filename)))
    2235             :            ;; Run find-file-not-found-functions until one returns non-nil.
    2236           0 :            (or (run-hook-with-args-until-success 'find-file-not-found-functions)
    2237             :                ;; If they fail too, set error.
    2238         148 :                (setq error t)))))
    2239             :       ;; Record the file's truename, and maybe use that as visited name.
    2240         148 :       (if (equal filename buffer-file-name)
    2241         148 :           (setq buffer-file-truename truename)
    2242           0 :         (setq buffer-file-truename
    2243         148 :               (abbreviate-file-name (file-truename buffer-file-name))))
    2244         148 :       (setq buffer-file-number number)
    2245         148 :       (if find-file-visit-truename
    2246         148 :           (setq buffer-file-name (expand-file-name buffer-file-truename)))
    2247             :       ;; Set buffer's default directory to that of the file.
    2248         148 :       (setq default-directory (file-name-directory buffer-file-name))
    2249             :       ;; Turn off backup files for certain file names.  Since
    2250             :       ;; this is a permanent local, the major mode won't eliminate it.
    2251         148 :       (and backup-enable-predicate
    2252         148 :            (not (funcall backup-enable-predicate buffer-file-name))
    2253           0 :            (progn
    2254           0 :              (make-local-variable 'backup-inhibited)
    2255         148 :              (setq backup-inhibited t)))
    2256         148 :       (if rawfile
    2257           0 :           (progn
    2258           0 :             (set-buffer-multibyte nil)
    2259           0 :             (setq buffer-file-coding-system 'no-conversion)
    2260           0 :             (set-buffer-major-mode buf)
    2261           0 :             (setq-local find-file-literally t))
    2262         148 :         (after-find-file error (not nowarn)))
    2263         148 :       (current-buffer))))
    2264             : 
    2265             : (defun insert-file-contents-literally (filename &optional visit beg end replace)
    2266             :   "Like `insert-file-contents', but only reads in the file literally.
    2267             : See `insert-file-contents' for an explanation of the parameters.
    2268             : A buffer may be modified in several ways after reading into the buffer,
    2269             : due to Emacs features such as format decoding, character code
    2270             : conversion, `find-file-hook', automatic uncompression, etc.
    2271             : 
    2272             : This function ensures that none of these modifications will take place."
    2273         573 :   (let ((format-alist nil)
    2274             :         (after-insert-file-functions nil)
    2275             :         (coding-system-for-read 'no-conversion)
    2276             :         (coding-system-for-write 'no-conversion)
    2277             :         (inhibit-file-name-handlers
    2278             :          ;; FIXME: Yuck!!  We should turn insert-file-contents-literally
    2279             :          ;; into a file operation instead!
    2280         573 :          (append '(jka-compr-handler image-file-handler epa-file-handler)
    2281         573 :                  inhibit-file-name-handlers))
    2282             :         (inhibit-file-name-operation 'insert-file-contents))
    2283         573 :     (insert-file-contents filename visit beg end replace)))
    2284             : 
    2285             : (defun insert-file-1 (filename insert-func)
    2286           0 :   (if (file-directory-p filename)
    2287           0 :       (signal 'file-error (list "Opening input file" "Is a directory"
    2288           0 :                                 filename)))
    2289             :   ;; Check whether the file is uncommonly large
    2290           0 :   (abort-if-file-too-large (nth 7 (file-attributes filename)) "insert" filename)
    2291           0 :   (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
    2292           0 :                                        #'buffer-modified-p))
    2293           0 :          (tem (funcall insert-func filename)))
    2294           0 :     (push-mark (+ (point) (car (cdr tem))))
    2295           0 :     (when buffer
    2296           0 :       (message "File %s already visited and modified in buffer %s"
    2297           0 :                filename (buffer-name buffer)))))
    2298             : 
    2299             : (defun insert-file-literally (filename)
    2300             :   "Insert contents of file FILENAME into buffer after point with no conversion.
    2301             : 
    2302             : This function is meant for the user to run interactively.
    2303             : Don't call it from programs!  Use `insert-file-contents-literally' instead.
    2304             : \(Its calling sequence is different; see its documentation)."
    2305             :   (declare (interactive-only insert-file-contents-literally))
    2306             :   (interactive "*fInsert file literally: ")
    2307           0 :   (insert-file-1 filename #'insert-file-contents-literally))
    2308             : 
    2309             : (defvar find-file-literally nil
    2310             :   "Non-nil if this buffer was made by `find-file-literally' or equivalent.
    2311             : This has the `permanent-local' property, which takes effect if you
    2312             : make the variable buffer-local.")
    2313             : (put 'find-file-literally 'permanent-local t)
    2314             : 
    2315             : (defun find-file-literally (filename)
    2316             :   "Visit file FILENAME with no conversion of any kind.
    2317             : Format conversion and character code conversion are both disabled,
    2318             : and multibyte characters are disabled in the resulting buffer.
    2319             : The major mode used is Fundamental mode regardless of the file name,
    2320             : and local variable specifications in the file are ignored.
    2321             : Automatic uncompression and adding a newline at the end of the
    2322             : file due to `require-final-newline' is also disabled.
    2323             : 
    2324             : You cannot absolutely rely on this function to result in
    2325             : visiting the file literally.  If Emacs already has a buffer
    2326             : which is visiting the file, you get the existing buffer,
    2327             : regardless of whether it was created literally or not.
    2328             : 
    2329             : In a Lisp program, if you want to be sure of accessing a file's
    2330             : contents literally, you should create a temporary buffer and then read
    2331             : the file contents into it using `insert-file-contents-literally'."
    2332             :   (interactive
    2333           0 :    (list (read-file-name
    2334           0 :           "Find file literally: " nil default-directory
    2335           0 :           (confirm-nonexistent-file-or-buffer))))
    2336           0 :   (switch-to-buffer (find-file-noselect filename nil t)))
    2337             : 
    2338             : (defun after-find-file (&optional error warn noauto
    2339             :                                   _after-find-file-from-revert-buffer
    2340             :                                   nomodes)
    2341             :   "Called after finding a file and by the default revert function.
    2342             : Sets buffer mode, parses local variables.
    2343             : Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
    2344             : error in reading the file.  WARN non-nil means warn if there
    2345             : exists an auto-save file more recent than the visited file.
    2346             : NOAUTO means don't mess with auto-save mode.
    2347             : Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER is ignored
    2348             : \(see `revert-buffer-in-progress-p' for similar functionality).
    2349             : Fifth arg NOMODES non-nil means don't alter the file's modes.
    2350             : Finishes by calling the functions in `find-file-hook'
    2351             : unless NOMODES is non-nil."
    2352         148 :   (setq buffer-read-only (not (file-writable-p buffer-file-name)))
    2353         148 :   (if noninteractive
    2354             :       nil
    2355           0 :     (let* (not-serious
    2356             :            (msg
    2357           0 :             (cond
    2358           0 :              ((not warn) nil)
    2359           0 :              ((and error (file-attributes buffer-file-name))
    2360           0 :               (setq buffer-read-only t)
    2361           0 :               (if (and (file-symlink-p buffer-file-name)
    2362           0 :                        (not (file-exists-p
    2363           0 :                              (file-chase-links buffer-file-name))))
    2364             :                   "Symbolic link that points to nonexistent file"
    2365           0 :                 "File exists, but cannot be read"))
    2366           0 :              ((not buffer-read-only)
    2367           0 :               (if (and warn
    2368             :                        ;; No need to warn if buffer is auto-saved
    2369             :                        ;; under the name of the visited file.
    2370           0 :                        (not (and buffer-file-name
    2371           0 :                                  auto-save-visited-file-name))
    2372           0 :                        (file-newer-than-file-p (or buffer-auto-save-file-name
    2373           0 :                                                    (make-auto-save-file-name))
    2374           0 :                                                buffer-file-name))
    2375           0 :                   (format "%s has auto save data; consider M-x recover-this-file"
    2376           0 :                           (file-name-nondirectory buffer-file-name))
    2377           0 :                 (setq not-serious t)
    2378           0 :                 (if error "(New file)" nil)))
    2379           0 :              ((not error)
    2380           0 :               (setq not-serious t)
    2381             :               "Note: file is write protected")
    2382           0 :              ((file-attributes (directory-file-name default-directory))
    2383             :               "File not found and directory write-protected")
    2384           0 :              ((file-exists-p (file-name-directory buffer-file-name))
    2385           0 :               (setq buffer-read-only nil))
    2386             :              (t
    2387           0 :               (setq buffer-read-only nil)
    2388           0 :               "Use M-x make-directory RET RET to create the directory and its parents"))))
    2389           0 :       (when msg
    2390           0 :         (message "%s" msg)
    2391           0 :         (or not-serious (sit-for 1 t))))
    2392           0 :     (when (and auto-save-default (not noauto))
    2393         148 :       (auto-save-mode 1)))
    2394             :   ;; Make people do a little extra work (C-x C-q)
    2395             :   ;; before altering a backup file.
    2396         148 :   (when (backup-file-name-p buffer-file-name)
    2397         148 :     (setq buffer-read-only t))
    2398             :   ;; When a file is marked read-only,
    2399             :   ;; make the buffer read-only even if root is looking at it.
    2400         148 :   (when (and (file-modes (buffer-file-name))
    2401         148 :              (zerop (logand (file-modes (buffer-file-name)) #o222)))
    2402         148 :     (setq buffer-read-only t))
    2403         148 :   (unless nomodes
    2404         148 :     (when (and view-read-only view-mode)
    2405         148 :       (view-mode -1))
    2406         148 :     (normal-mode t)
    2407             :     ;; If requested, add a newline at the end of the file.
    2408         148 :     (and (memq require-final-newline '(visit visit-save))
    2409           0 :          (> (point-max) (point-min))
    2410           0 :          (/= (char-after (1- (point-max))) ?\n)
    2411           0 :          (not (and (eq selective-display t)
    2412           0 :                    (= (char-after (1- (point-max))) ?\r)))
    2413           0 :          (not buffer-read-only)
    2414           0 :          (save-excursion
    2415           0 :            (goto-char (point-max))
    2416         148 :            (ignore-errors (insert "\n"))))
    2417         148 :     (when (and buffer-read-only
    2418           0 :                view-read-only
    2419         148 :                (not (eq (get major-mode 'mode-class) 'special)))
    2420         148 :       (view-mode-enter))
    2421         148 :     (run-hooks 'find-file-hook)))
    2422             : 
    2423             : (define-obsolete-function-alias 'report-errors 'with-demoted-errors "25.1")
    2424             : 
    2425             : (defun normal-mode (&optional find-file)
    2426             :   "Choose the major mode for this buffer automatically.
    2427             : Also sets up any specified local variables of the file.
    2428             : Uses the visited file name, the -*- line, and the local variables spec.
    2429             : 
    2430             : This function is called automatically from `find-file'.  In that case,
    2431             : we may set up the file-specified mode and local variables,
    2432             : depending on the value of `enable-local-variables'.
    2433             : In addition, if `local-enable-local-variables' is nil, we do
    2434             : not set local variables (though we do notice a mode specified with -*-.)
    2435             : 
    2436             : `enable-local-variables' is ignored if you run `normal-mode' interactively,
    2437             : or from Lisp without specifying the optional argument FIND-FILE;
    2438             : in that case, this function acts as if `enable-local-variables' were t."
    2439             :   (interactive)
    2440         148 :   (kill-all-local-variables)
    2441         148 :   (unless delay-mode-hooks
    2442         148 :     (run-hooks 'change-major-mode-after-body-hook
    2443         148 :                'after-change-major-mode-hook))
    2444         148 :   (let ((enable-local-variables (or (not find-file) enable-local-variables)))
    2445             :     ;; FIXME this is less efficient than it could be, since both
    2446             :     ;; s-a-m and h-l-v may parse the same regions, looking for "mode:".
    2447         148 :     (with-demoted-errors "File mode specification error: %s"
    2448         148 :       (set-auto-mode))
    2449             :     ;; `delay-mode-hooks' being non-nil will have prevented the major
    2450             :     ;; mode's call to `run-mode-hooks' from calling
    2451             :     ;; `hack-local-variables'.  In that case, call it now.
    2452         148 :     (when delay-mode-hooks
    2453           0 :       (with-demoted-errors "File local-variables error: %s"
    2454         148 :         (hack-local-variables 'no-mode))))
    2455             :   ;; Turn font lock off and on, to make sure it takes account of
    2456             :   ;; whatever file local variables are relevant to it.
    2457         148 :   (when (and font-lock-mode
    2458             :              ;; Font-lock-mode (now in font-core.el) can be ON when
    2459             :              ;; font-lock.el still hasn't been loaded.
    2460           0 :              (boundp 'font-lock-keywords)
    2461         148 :              (eq (car font-lock-keywords) t))
    2462           0 :     (setq font-lock-keywords (cadr font-lock-keywords))
    2463         148 :     (font-lock-mode 1)))
    2464             : 
    2465             : (defcustom auto-mode-case-fold t
    2466             :   "Non-nil means to try second pass through `auto-mode-alist'.
    2467             : This means that if the first case-sensitive search through the alist fails
    2468             : to find a matching major mode, a second case-insensitive search is made.
    2469             : On systems with case-insensitive file names, this variable is ignored,
    2470             : since only a single case-insensitive search through the alist is made."
    2471             :   :group 'files
    2472             :   :version "22.1"
    2473             :   :type 'boolean)
    2474             : 
    2475             : (defvar auto-mode-alist
    2476             :   ;; Note: The entries for the modes defined in cc-mode.el (c-mode,
    2477             :   ;; c++-mode, java-mode and more) are added through autoload
    2478             :   ;; directives in that file.  That way is discouraged since it
    2479             :   ;; spreads out the definition of the initial value.
    2480             :   (mapcar
    2481             :    (lambda (elt)
    2482             :      (cons (purecopy (car elt)) (cdr elt)))
    2483             :    `(;; do this first, so that .html.pl is Polish html, not Perl
    2484             :      ("\\.[sx]?html?\\(\\.[a-zA-Z_]+\\)?\\'" . mhtml-mode)
    2485             :      ("\\.svgz?\\'" . image-mode)
    2486             :      ("\\.svgz?\\'" . xml-mode)
    2487             :      ("\\.x[bp]m\\'" . image-mode)
    2488             :      ("\\.x[bp]m\\'" . c-mode)
    2489             :      ("\\.p[bpgn]m\\'" . image-mode)
    2490             :      ("\\.tiff?\\'" . image-mode)
    2491             :      ("\\.gif\\'" . image-mode)
    2492             :      ("\\.png\\'" . image-mode)
    2493             :      ("\\.jpe?g\\'" . image-mode)
    2494             :      ("\\.te?xt\\'" . text-mode)
    2495             :      ("\\.[tT]e[xX]\\'" . tex-mode)
    2496             :      ("\\.ins\\'" . tex-mode)         ;Installation files for TeX packages.
    2497             :      ("\\.ltx\\'" . latex-mode)
    2498             :      ("\\.dtx\\'" . doctex-mode)
    2499             :      ("\\.org\\'" . org-mode)
    2500             :      ("\\.el\\'" . emacs-lisp-mode)
    2501             :      ("Project\\.ede\\'" . emacs-lisp-mode)
    2502             :      ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
    2503             :      ("\\.l\\'" . lisp-mode)
    2504             :      ("\\.li?sp\\'" . lisp-mode)
    2505             :      ("\\.[fF]\\'" . fortran-mode)
    2506             :      ("\\.for\\'" . fortran-mode)
    2507             :      ("\\.p\\'" . pascal-mode)
    2508             :      ("\\.pas\\'" . pascal-mode)
    2509             :      ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode)
    2510             :      ("\\.ad[abs]\\'" . ada-mode)
    2511             :      ("\\.ad[bs].dg\\'" . ada-mode)
    2512             :      ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
    2513             :      ("Imakefile\\'" . makefile-imake-mode)
    2514             :      ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk
    2515             :      ("\\.makepp\\'" . makefile-makepp-mode)
    2516             :      ,@(if (memq system-type '(berkeley-unix darwin))
    2517             :            '(("\\.mk\\'" . makefile-bsdmake-mode)
    2518             :              ("\\.make\\'" . makefile-bsdmake-mode)
    2519             :              ("GNUmakefile\\'" . makefile-gmake-mode)
    2520             :              ("[Mm]akefile\\'" . makefile-bsdmake-mode))
    2521             :          '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
    2522             :            ("\\.make\\'" . makefile-gmake-mode)
    2523             :            ("[Mm]akefile\\'" . makefile-gmake-mode)))
    2524             :      ("\\.am\\'" . makefile-automake-mode)
    2525             :      ;; Less common extensions come here
    2526             :      ;; so more common ones above are found faster.
    2527             :      ("\\.texinfo\\'" . texinfo-mode)
    2528             :      ("\\.te?xi\\'" . texinfo-mode)
    2529             :      ("\\.[sS]\\'" . asm-mode)
    2530             :      ("\\.asm\\'" . asm-mode)
    2531             :      ("\\.css\\'" . css-mode)
    2532             :      ("\\.mixal\\'" . mixal-mode)
    2533             :      ("\\.gcov\\'" . compilation-mode)
    2534             :      ;; Besides .gdbinit, gdb documents other names to be usable for init
    2535             :      ;; files, cross-debuggers can use something like
    2536             :      ;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files
    2537             :      ;; don't interfere with each other.
    2538             :      ("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode)
    2539             :      ;; GDB 7.5 introduced OBJFILE-gdb.gdb script files; e.g. a file
    2540             :      ;; named 'emacs-gdb.gdb', if it exists, will be automatically
    2541             :      ;; loaded when GDB reads an objfile called 'emacs'.
    2542             :      ("-gdb\\.gdb" . gdb-script-mode)
    2543             :      ("[cC]hange\\.?[lL]og?\\'" . change-log-mode)
    2544             :      ("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode)
    2545             :      ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
    2546             :      ("\\.scm\\.[0-9]*\\'" . scheme-mode)
    2547             :      ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
    2548             :      ("\\.bash\\'" . sh-mode)
    2549             :      ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode)
    2550             :      ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
    2551             :      ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
    2552             :      ("\\.m?spec\\'" . sh-mode)
    2553             :      ("\\.m[mes]\\'" . nroff-mode)
    2554             :      ("\\.man\\'" . nroff-mode)
    2555             :      ("\\.sty\\'" . latex-mode)
    2556             :      ("\\.cl[so]\\'" . latex-mode)            ;LaTeX 2e class option
    2557             :      ("\\.bbl\\'" . latex-mode)
    2558             :      ("\\.bib\\'" . bibtex-mode)
    2559             :      ("\\.bst\\'" . bibtex-style-mode)
    2560             :      ("\\.sql\\'" . sql-mode)
    2561             :      ("\\.m[4c]\\'" . m4-mode)
    2562             :      ("\\.mf\\'" . metafont-mode)
    2563             :      ("\\.mp\\'" . metapost-mode)
    2564             :      ("\\.vhdl?\\'" . vhdl-mode)
    2565             :      ("\\.article\\'" . text-mode)
    2566             :      ("\\.letter\\'" . text-mode)
    2567             :      ("\\.i?tcl\\'" . tcl-mode)
    2568             :      ("\\.exp\\'" . tcl-mode)
    2569             :      ("\\.itk\\'" . tcl-mode)
    2570             :      ("\\.icn\\'" . icon-mode)
    2571             :      ("\\.sim\\'" . simula-mode)
    2572             :      ("\\.mss\\'" . scribe-mode)
    2573             :      ;; The Fortran standard does not say anything about file extensions.
    2574             :      ;; .f90 was widely used for F90, now we seem to be trapped into
    2575             :      ;; using a different extension for each language revision.
    2576             :      ;; Anyway, the following extensions are supported by gfortran.
    2577             :      ("\\.f9[05]\\'" . f90-mode)
    2578             :      ("\\.f0[38]\\'" . f90-mode)
    2579             :      ("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
    2580             :      ("\\.\\(pro\\|PRO\\)\\'" . idlwave-mode)
    2581             :      ("\\.srt\\'" . srecode-template-mode)
    2582             :      ("\\.prolog\\'" . prolog-mode)
    2583             :      ("\\.tar\\'" . tar-mode)
    2584             :      ;; The list of archive file extensions should be in sync with
    2585             :      ;; `auto-coding-alist' with `no-conversion' coding system.
    2586             :      ("\\.\\(\
    2587             : arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|\
    2588             : ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mode)
    2589             :      ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions.
    2590             :      ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages.
    2591             :      ;; Mailer puts message to be edited in
    2592             :      ;; /tmp/Re.... or Message
    2593             :      ("\\`/tmp/Re" . text-mode)
    2594             :      ("/Message[0-9]*\\'" . text-mode)
    2595             :      ;; some news reader is reported to use this
    2596             :      ("\\`/tmp/fol/" . text-mode)
    2597             :      ("\\.oak\\'" . scheme-mode)
    2598             :      ("\\.sgml?\\'" . sgml-mode)
    2599             :      ("\\.x[ms]l\\'" . xml-mode)
    2600             :      ("\\.dbk\\'" . xml-mode)
    2601             :      ("\\.dtd\\'" . sgml-mode)
    2602             :      ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
    2603             :      ("\\.jsm?\\'" . javascript-mode)
    2604             :      ("\\.json\\'" . javascript-mode)
    2605             :      ("\\.jsx\\'" . js-jsx-mode)
    2606             :      ("\\.[ds]?vh?\\'" . verilog-mode)
    2607             :      ("\\.by\\'" . bovine-grammar-mode)
    2608             :      ("\\.wy\\'" . wisent-grammar-mode)
    2609             :      ;; .emacs or .gnus or .viper following a directory delimiter in
    2610             :      ;; Unix or MS-DOS syntax.
    2611             :      ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
    2612             :      ("\\`\\..*emacs\\'" . emacs-lisp-mode)
    2613             :      ;; _emacs following a directory delimiter in MS-DOS syntax
    2614             :      ("[:/]_emacs\\'" . emacs-lisp-mode)
    2615             :      ("/crontab\\.X*[0-9]+\\'" . shell-script-mode)
    2616             :      ("\\.ml\\'" . lisp-mode)
    2617             :      ;; Linux-2.6.9 uses some different suffix for linker scripts:
    2618             :      ;; "ld", "lds", "lds.S", "lds.in", "ld.script", and "ld.script.balo".
    2619             :      ;; eCos uses "ld" and "ldi".  Netbsd uses "ldscript.*".
    2620             :      ("\\.ld[si]?\\'" . ld-script-mode)
    2621             :      ("ld\\.?script\\'" . ld-script-mode)
    2622             :      ;; .xs is also used for ld scripts, but seems to be more commonly
    2623             :      ;; associated with Perl .xs files (C with Perl bindings).  (Bug#7071)
    2624             :      ("\\.xs\\'" . c-mode)
    2625             :      ;; Explained in binutils ld/genscripts.sh.  Eg:
    2626             :      ;; A .x script file is the default script.
    2627             :      ;; A .xr script is for linking without relocation (-r flag).  Etc.
    2628             :      ("\\.x[abdsru]?[cnw]?\\'" . ld-script-mode)
    2629             :      ("\\.zone\\'" . dns-mode)
    2630             :      ("\\.soa\\'" . dns-mode)
    2631             :      ;; Common Lisp ASDF package system.
    2632             :      ("\\.asd\\'" . lisp-mode)
    2633             :      ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode)
    2634             :      ("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode)
    2635             :      ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
    2636             :      ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS
    2637             :      ("\\.[eE]?[pP][sS]\\'" . ps-mode)
    2638             :      ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX?\\|XLSX?\\|PPTX?\\|pdf\\|djvu\\|dvi\\|od[fgpst]\\|docx?\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe)
    2639             :      ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
    2640             :      ("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode)
    2641             :      ("BROWSE\\'" . ebrowse-tree-mode)
    2642             :      ("\\.ebrowse\\'" . ebrowse-tree-mode)
    2643             :      ("#\\*mail\\*" . mail-mode)
    2644             :      ("\\.g\\'" . antlr-mode)
    2645             :      ("\\.mod\\'" . m2-mode)
    2646             :      ("\\.ses\\'" . ses-mode)
    2647             :      ("\\.docbook\\'" . sgml-mode)
    2648             :      ("\\.com\\'" . dcl-mode)
    2649             :      ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode)
    2650             :      ;; Windows candidates may be opened case sensitively on Unix
    2651             :      ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode)
    2652             :      ("\\.\\(?:desktop\\|la\\)\\'" . conf-unix-mode)
    2653             :      ("\\.ppd\\'" . conf-ppd-mode)
    2654             :      ("java.+\\.conf\\'" . conf-javaprop-mode)
    2655             :      ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
    2656             :      ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
    2657             :      ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
    2658             :      ;; ChangeLog.old etc.  Other change-log-mode entries are above;
    2659             :      ;; this has lower priority to avoid matching changelog.sgml etc.
    2660             :      ("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode)
    2661             :      ;; either user's dot-files or under /etc or some such
    2662             :      ("/\\.?\\(?:gitconfig\\|gnokiirc\\|hgrc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
    2663             :      ;; alas not all ~/.*rc files are like this
    2664             :      ("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode)
    2665             :      ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode)
    2666             :      ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode)
    2667             :      ("/X11.+app-defaults/\\|\\.ad\\'" . conf-xdefaults-mode)
    2668             :      ("/X11.+locale/.+/Compose\\'" . conf-colon-mode)
    2669             :      ;; this contains everything twice, with space and with colon :-(
    2670             :      ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode)
    2671             :      ;; Get rid of any trailing .n.m and try again.
    2672             :      ;; This is for files saved by cvs-merge that look like .#<file>.<rev>
    2673             :      ;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~.
    2674             :      ;; Using mode nil rather than `ignore' would let the search continue
    2675             :      ;; through this list (with the shortened name) rather than start over.
    2676             :      ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t)
    2677             :      ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t)
    2678             :      ;; This should come after "in" stripping (e.g. config.h.in).
    2679             :      ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
    2680             :      ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe)
    2681             :      ;; The following should come after the ChangeLog pattern
    2682             :      ;; for the sake of ChangeLog.1, etc.
    2683             :      ;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
    2684             :      ("\\.[1-9]\\'" . nroff-mode)))
    2685             :   "Alist of filename patterns vs corresponding major mode functions.
    2686             : Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
    2687             : \(NON-NIL stands for anything that is not nil; the value does not matter.)
    2688             : Visiting a file whose name matches REGEXP specifies FUNCTION as the
    2689             : mode function to use.  FUNCTION will be called, unless it is nil.
    2690             : 
    2691             : If the element has the form (REGEXP FUNCTION NON-NIL), then after
    2692             : calling FUNCTION (if it's not nil), we delete the suffix that matched
    2693             : REGEXP and search the list again for another match.
    2694             : 
    2695             : The extensions whose FUNCTION is `archive-mode' should also
    2696             : appear in `auto-coding-alist' with `no-conversion' coding system.
    2697             : 
    2698             : See also `interpreter-mode-alist', which detects executable script modes
    2699             : based on the interpreters they specify to run,
    2700             : and `magic-mode-alist', which determines modes based on file contents.")
    2701             : (put 'auto-mode-alist 'risky-local-variable t)
    2702             : 
    2703             : (defun conf-mode-maybe ()
    2704             :   "Select Conf mode or XML mode according to start of file."
    2705           0 :   (if (save-excursion
    2706           0 :         (save-restriction
    2707           0 :           (widen)
    2708           0 :           (goto-char (point-min))
    2709           0 :           (looking-at "<\\?xml \\|<!-- \\|<!DOCTYPE ")))
    2710           0 :       (xml-mode)
    2711           0 :     (conf-mode)))
    2712             : 
    2713             : (defvar interpreter-mode-alist
    2714             :   ;; Note: The entries for the modes defined in cc-mode.el (awk-mode
    2715             :   ;; and pike-mode) are added through autoload directives in that
    2716             :   ;; file.  That way is discouraged since it spreads out the
    2717             :   ;; definition of the initial value.
    2718             :   (mapcar
    2719             :    (lambda (l)
    2720             :      (cons (purecopy (car l)) (cdr l)))
    2721             :    '(("\\(mini\\)?perl5?" . perl-mode)
    2722             :      ("wishx?" . tcl-mode)
    2723             :      ("tcl\\(sh\\)?" . tcl-mode)
    2724             :      ("expect" . tcl-mode)
    2725             :      ("octave" . octave-mode)
    2726             :      ("scm" . scheme-mode)
    2727             :      ("[acjkwz]sh" . sh-mode)
    2728             :      ("r?bash2?" . sh-mode)
    2729             :      ("dash" . sh-mode)
    2730             :      ("mksh" . sh-mode)
    2731             :      ("\\(dt\\|pd\\|w\\)ksh" . sh-mode)
    2732             :      ("es" . sh-mode)
    2733             :      ("i?tcsh" . sh-mode)
    2734             :      ("oash" . sh-mode)
    2735             :      ("rc" . sh-mode)
    2736             :      ("rpm" . sh-mode)
    2737             :      ("sh5?" . sh-mode)
    2738             :      ("tail" . text-mode)
    2739             :      ("more" . text-mode)
    2740             :      ("less" . text-mode)
    2741             :      ("pg" . text-mode)
    2742             :      ("make" . makefile-gmake-mode)           ; Debian uses this
    2743             :      ("guile" . scheme-mode)
    2744             :      ("clisp" . lisp-mode)
    2745             :      ("emacs" . emacs-lisp-mode)))
    2746             :   "Alist mapping interpreter names to major modes.
    2747             : This is used for files whose first lines match `auto-mode-interpreter-regexp'.
    2748             : Each element looks like (REGEXP . MODE).
    2749             : If REGEXP matches the entire name (minus any directory part) of
    2750             : the interpreter specified in the first line of a script, enable
    2751             : major mode MODE.
    2752             : 
    2753             : See also `auto-mode-alist'.")
    2754             : 
    2755             : (define-obsolete-variable-alias 'inhibit-first-line-modes-regexps
    2756             :   'inhibit-file-local-variables-regexps "24.1")
    2757             : 
    2758             : ;; TODO really this should be a list of modes (eg tar-mode), not regexps,
    2759             : ;; because we are duplicating info from auto-mode-alist.
    2760             : ;; TODO many elements of this list are also in auto-coding-alist.
    2761             : (defvar inhibit-local-variables-regexps
    2762             :   (mapcar 'purecopy '("\\.tar\\'" "\\.t[bg]z\\'"
    2763             :                       "\\.arc\\'" "\\.zip\\'" "\\.lzh\\'" "\\.lha\\'"
    2764             :                       "\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'"
    2765             :                       "\\.7z\\'"
    2766             :                       "\\.sx[dmicw]\\'" "\\.odt\\'"
    2767             :                       "\\.diff\\'" "\\.patch\\'"
    2768             :                       "\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
    2769             :   "List of regexps matching file names in which to ignore local variables.
    2770             : This includes `-*-' lines as well as trailing \"Local Variables\" sections.
    2771             : Files matching this list are typically binary file formats.
    2772             : They may happen to contain sequences that look like local variable
    2773             : specifications, but are not really, or they may be containers for
    2774             : member files with their own local variable sections, which are
    2775             : not appropriate for the containing file.
    2776             : The function `inhibit-local-variables-p' uses this.")
    2777             : 
    2778             : (define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes
    2779             :   'inhibit-local-variables-suffixes "24.1")
    2780             : 
    2781             : (defvar inhibit-local-variables-suffixes nil
    2782             :   "List of regexps matching suffixes to remove from file names.
    2783             : The function `inhibit-local-variables-p' uses this: when checking
    2784             : a file name, it first discards from the end of the name anything that
    2785             : matches one of these regexps.")
    2786             : 
    2787             : ;; Can't think of any situation in which you'd want this to be nil...
    2788             : (defvar inhibit-local-variables-ignore-case t
    2789             :   "Non-nil means `inhibit-local-variables-p' ignores case.")
    2790             : 
    2791             : (defun inhibit-local-variables-p ()
    2792             :   "Return non-nil if file local variables should be ignored.
    2793             : This checks the file (or buffer) name against `inhibit-local-variables-regexps'
    2794             : and `inhibit-local-variables-suffixes'.  If
    2795             : `inhibit-local-variables-ignore-case' is non-nil, this ignores case."
    2796         909 :   (let ((temp inhibit-local-variables-regexps)
    2797         909 :         (name (if buffer-file-name
    2798         888 :                   (file-name-sans-versions buffer-file-name)
    2799         909 :                 (buffer-name)))
    2800         909 :         (case-fold-search inhibit-local-variables-ignore-case))
    2801         909 :     (while (let ((sufs inhibit-local-variables-suffixes))
    2802        8181 :              (while (and sufs (not (string-match (car sufs) name)))
    2803        7272 :                (setq sufs (cdr sufs)))
    2804         909 :              sufs)
    2805         909 :       (setq name (substring name 0 (match-beginning 0))))
    2806       18180 :     (while (and temp
    2807       18180 :                 (not (string-match (car temp) name)))
    2808       17271 :       (setq temp (cdr temp)))
    2809         909 :     temp))
    2810             : 
    2811             : (defvar auto-mode-interpreter-regexp
    2812             :   (purecopy "#![ \t]?\\([^ \t\n]*\
    2813             : /bin/env[ \t]\\)?\\([^ \t\n]+\\)")
    2814             :   "Regexp matching interpreters, for file mode determination.
    2815             : This regular expression is matched against the first line of a file
    2816             : to determine the file's mode in `set-auto-mode'.  If it matches, the file
    2817             : is assumed to be interpreted by the interpreter matched by the second group
    2818             : of the regular expression.  The mode is then determined as the mode
    2819             : associated with that interpreter in `interpreter-mode-alist'.")
    2820             : 
    2821             : (defvar magic-mode-alist nil
    2822             :   "Alist of buffer beginnings vs. corresponding major mode functions.
    2823             : Each element looks like (REGEXP . FUNCTION) or (MATCH-FUNCTION . FUNCTION).
    2824             : After visiting a file, if REGEXP matches the text at the beginning of the
    2825             : buffer, or calling MATCH-FUNCTION returns non-nil, `normal-mode' will
    2826             : call FUNCTION rather than allowing `auto-mode-alist' to decide the buffer's
    2827             : major mode.
    2828             : 
    2829             : If FUNCTION is nil, then it is not called.  (That is a way of saying
    2830             : \"allow `auto-mode-alist' to decide for these files.\")")
    2831             : (put 'magic-mode-alist 'risky-local-variable t)
    2832             : 
    2833             : (defvar magic-fallback-mode-alist
    2834             :   (purecopy
    2835             :   `((image-type-auto-detected-p . image-mode)
    2836             :     ("\\(PK00\\)?[P]K\003\004" . archive-mode) ; zip
    2837             :     ;; The < comes before the groups (but the first) to reduce backtracking.
    2838             :     ;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff.
    2839             :     ;; We use [ \t\r\n] instead of `\\s ' to make regex overflow less likely.
    2840             :     (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
    2841             :              (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
    2842             :         (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<"
    2843             :                 comment-re "*"
    2844             :                 "\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?"
    2845             :                 "[Hh][Tt][Mm][Ll]"))
    2846             :      . mhtml-mode)
    2847             :     ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
    2848             :     ;; These two must come after html, because they are more general:
    2849             :     ("<\\?xml " . xml-mode)
    2850             :     (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
    2851             :              (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
    2852             :         (concat "[ \t\r\n]*<" comment-re "*!DOCTYPE "))
    2853             :      . sgml-mode)
    2854             :     ("%!PS" . ps-mode)
    2855             :     ("# xmcd " . conf-unix-mode)))
    2856             :   "Like `magic-mode-alist' but has lower priority than `auto-mode-alist'.
    2857             : Each element looks like (REGEXP . FUNCTION) or (MATCH-FUNCTION . FUNCTION).
    2858             : After visiting a file, if REGEXP matches the text at the beginning of the
    2859             : buffer, or calling MATCH-FUNCTION returns non-nil, `normal-mode' will
    2860             : call FUNCTION, provided that `magic-mode-alist' and `auto-mode-alist'
    2861             : have not specified a mode for this file.
    2862             : 
    2863             : If FUNCTION is nil, then it is not called.")
    2864             : (put 'magic-fallback-mode-alist 'risky-local-variable t)
    2865             : 
    2866             : (defvar magic-mode-regexp-match-limit 4000
    2867             :   "Upper limit on `magic-mode-alist' regexp matches.
    2868             : Also applies to `magic-fallback-mode-alist'.")
    2869             : 
    2870             : (defun set-auto-mode (&optional keep-mode-if-same)
    2871             :   "Select major mode appropriate for current buffer.
    2872             : 
    2873             : To find the right major mode, this function checks for a -*- mode tag
    2874             : checks for a `mode:' entry in the Local Variables section of the file,
    2875             : checks if it uses an interpreter listed in `interpreter-mode-alist',
    2876             : matches the buffer beginning against `magic-mode-alist',
    2877             : compares the filename against the entries in `auto-mode-alist',
    2878             : then matches the buffer beginning against `magic-fallback-mode-alist'.
    2879             : 
    2880             : If `enable-local-variables' is nil, or if the file name matches
    2881             : `inhibit-local-variables-regexps', this function does not check
    2882             : for any mode: tag anywhere in the file.  If `local-enable-local-variables'
    2883             : is nil, then the only mode: tag that can be relevant is a -*- one.
    2884             : 
    2885             : If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
    2886             : set the major mode only if that would change it.  In other words
    2887             : we don't actually set it to the same mode the buffer already has."
    2888             :   ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
    2889         148 :   (let ((try-locals (not (inhibit-local-variables-p)))
    2890             :         end done mode modes)
    2891             :     ;; Once we drop the deprecated feature where mode: is also allowed to
    2892             :     ;; specify minor-modes (ie, there can be more than one "mode:"), we can
    2893             :     ;; remove this section and just let (hack-local-variables t) handle it.
    2894             :     ;; Find a -*- mode tag.
    2895         148 :     (save-excursion
    2896         148 :       (goto-char (point-min))
    2897         148 :       (skip-chars-forward " \t\n")
    2898             :       ;; Note by design local-enable-local-variables does not matter here.
    2899         148 :       (and enable-local-variables
    2900         148 :            try-locals
    2901         148 :            (setq end (set-auto-mode-1))
    2902          83 :            (if (save-excursion (search-forward ":" end t))
    2903             :                ;; Find all specifications for the `mode:' variable
    2904             :                ;; and execute them left to right.
    2905          83 :                (while (let ((case-fold-search t))
    2906          83 :                         (or (and (looking-at "mode:")
    2907          83 :                                  (goto-char (match-end 0)))
    2908          83 :                             (re-search-forward "[ \t;]mode:" end t)))
    2909           0 :                  (skip-chars-forward " \t")
    2910           0 :                  (let ((beg (point)))
    2911           0 :                    (if (search-forward ";" end t)
    2912           0 :                        (forward-char -1)
    2913           0 :                      (goto-char end))
    2914           0 :                    (skip-chars-backward " \t")
    2915           0 :                    (push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
    2916          83 :                          modes)))
    2917             :              ;; Simple -*-MODE-*- case.
    2918           0 :              (push (intern (concat (downcase (buffer-substring (point) end))
    2919           0 :                                    "-mode"))
    2920         148 :                    modes))))
    2921             :     ;; If we found modes to use, invoke them now, outside the save-excursion.
    2922         148 :     (if modes
    2923           0 :         (catch 'nop
    2924           0 :           (dolist (mode (nreverse modes))
    2925           0 :             (if (not (functionp mode))
    2926           0 :                 (message "Ignoring unknown mode `%s'" mode)
    2927           0 :               (setq done t)
    2928           0 :               (or (set-auto-mode-0 mode keep-mode-if-same)
    2929             :                   ;; continuing would call minor modes again, toggling them off
    2930         148 :                   (throw 'nop nil))))))
    2931             :     ;; hack-local-variables checks local-enable-local-variables etc, but
    2932             :     ;; we might as well be explicit here for the sake of clarity.
    2933         148 :     (and (not done)
    2934         148 :          enable-local-variables
    2935         148 :          local-enable-local-variables
    2936         148 :          try-locals
    2937         148 :          (setq mode (hack-local-variables t))
    2938           2 :          (not (memq mode modes))        ; already tried and failed
    2939           2 :          (if (not (functionp mode))
    2940           0 :              (message "Ignoring unknown mode `%s'" mode)
    2941           2 :            (setq done t)
    2942         148 :            (set-auto-mode-0 mode keep-mode-if-same)))
    2943             :     ;; If we didn't, look for an interpreter specified in the first line.
    2944             :     ;; As a special case, allow for things like "#!/bin/env perl", which
    2945             :     ;; finds the interpreter anywhere in $PATH.
    2946         148 :     (and (not done)
    2947         146 :          (setq mode (save-excursion
    2948         146 :                       (goto-char (point-min))
    2949         146 :                       (if (looking-at auto-mode-interpreter-regexp)
    2950         146 :                           (match-string 2))))
    2951             :          ;; Map interpreter name to a mode, signaling we're done at the
    2952             :          ;; same time.
    2953           0 :          (setq done (assoc-default
    2954           0 :                      (file-name-nondirectory mode)
    2955           0 :                      (mapcar (lambda (e)
    2956           0 :                                (cons
    2957           0 :                                 (format "\\`%s\\'" (car e))
    2958           0 :                                 (cdr e)))
    2959           0 :                              interpreter-mode-alist)
    2960           0 :                      #'string-match-p))
    2961             :          ;; If we found an interpreter mode to use, invoke it now.
    2962         148 :          (set-auto-mode-0 done keep-mode-if-same))
    2963             :     ;; Next try matching the buffer beginning against magic-mode-alist.
    2964         148 :     (unless done
    2965         146 :       (if (setq done (save-excursion
    2966         146 :                        (goto-char (point-min))
    2967         146 :                        (save-restriction
    2968         146 :                          (narrow-to-region (point-min)
    2969         146 :                                            (min (point-max)
    2970         146 :                                                 (+ (point-min) magic-mode-regexp-match-limit)))
    2971         146 :                          (assoc-default
    2972         146 :                           nil magic-mode-alist
    2973             :                           (lambda (re _dummy)
    2974           0 :                             (cond
    2975           0 :                              ((functionp re)
    2976           0 :                               (funcall re))
    2977           0 :                              ((stringp re)
    2978           0 :                               (looking-at re))
    2979             :                              (t
    2980           0 :                               (error
    2981             :                                "Problem in magic-mode-alist with element %s"
    2982         146 :                                re))))))))
    2983         148 :           (set-auto-mode-0 done keep-mode-if-same)))
    2984             :     ;; Next compare the filename against the entries in auto-mode-alist.
    2985         148 :     (unless done
    2986         146 :       (if buffer-file-name
    2987         146 :           (let ((name buffer-file-name)
    2988         146 :                 (remote-id (file-remote-p buffer-file-name))
    2989         146 :                 (case-insensitive-p (file-name-case-insensitive-p
    2990         146 :                                      buffer-file-name)))
    2991             :             ;; Remove backup-suffixes from file name.
    2992         146 :             (setq name (file-name-sans-versions name))
    2993             :             ;; Remove remote file name identification.
    2994         146 :             (when (and (stringp remote-id)
    2995         146 :                        (string-match (regexp-quote remote-id) name))
    2996         146 :               (setq name (substring name (match-end 0))))
    2997         292 :             (while name
    2998             :               ;; Find first matching alist entry.
    2999         146 :               (setq mode
    3000         146 :                     (if case-insensitive-p
    3001             :                         ;; Filesystem is case-insensitive.
    3002           0 :                         (let ((case-fold-search t))
    3003           0 :                           (assoc-default name auto-mode-alist
    3004           0 :                                          'string-match))
    3005             :                       ;; Filesystem is case-sensitive.
    3006         146 :                       (or
    3007             :                        ;; First match case-sensitively.
    3008         146 :                        (let ((case-fold-search nil))
    3009         146 :                          (assoc-default name auto-mode-alist
    3010         146 :                                         'string-match))
    3011             :                        ;; Fallback to case-insensitive match.
    3012           0 :                        (and auto-mode-case-fold
    3013           0 :                             (let ((case-fold-search t))
    3014           0 :                               (assoc-default name auto-mode-alist
    3015         146 :                                              'string-match))))))
    3016         146 :               (if (and mode
    3017         146 :                        (consp mode)
    3018         146 :                        (cadr mode))
    3019           0 :                   (setq mode (car mode)
    3020           0 :                         name (substring name 0 (match-beginning 0)))
    3021         146 :                 (setq name nil))
    3022         146 :               (when mode
    3023         146 :                 (set-auto-mode-0 mode keep-mode-if-same)
    3024         148 :                 (setq done t))))))
    3025             :     ;; Next try matching the buffer beginning against magic-fallback-mode-alist.
    3026         148 :     (unless done
    3027           0 :       (if (setq done (save-excursion
    3028           0 :                        (goto-char (point-min))
    3029           0 :                        (save-restriction
    3030           0 :                          (narrow-to-region (point-min)
    3031           0 :                                            (min (point-max)
    3032           0 :                                                 (+ (point-min) magic-mode-regexp-match-limit)))
    3033           0 :                          (assoc-default nil magic-fallback-mode-alist
    3034             :                                         (lambda (re _dummy)
    3035           0 :                                           (cond
    3036           0 :                                            ((functionp re)
    3037           0 :                                             (funcall re))
    3038           0 :                                            ((stringp re)
    3039           0 :                                             (looking-at re))
    3040             :                                            (t
    3041           0 :                                             (error
    3042             :                                              "Problem with magic-fallback-mode-alist element: %s"
    3043           0 :                                              re))))))))
    3044         148 :           (set-auto-mode-0 done keep-mode-if-same)))
    3045         148 :     (unless done
    3046         148 :       (set-buffer-major-mode (current-buffer)))))
    3047             : 
    3048             : ;; When `keep-mode-if-same' is set, we are working on behalf of
    3049             : ;; set-visited-file-name.  In that case, if the major mode specified is the
    3050             : ;; same one we already have, don't actually reset it.  We don't want to lose
    3051             : ;; minor modes such as Font Lock.
    3052             : (defun set-auto-mode-0 (mode &optional keep-mode-if-same)
    3053             :   "Apply MODE and return it.
    3054             : If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
    3055             : any aliases and compared to current major mode.  If they are the
    3056             : same, do nothing and return nil."
    3057         148 :   (unless (and keep-mode-if-same
    3058           0 :                (eq (indirect-function mode)
    3059         148 :                    (indirect-function major-mode)))
    3060         148 :     (when mode
    3061         148 :       (funcall mode)
    3062         148 :       mode)))
    3063             : 
    3064             : (defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
    3065             :   "Regexp of lines to skip when looking for file-local settings.
    3066             : If the first line matches this regular expression, then the -*-...-*- file-
    3067             : local settings will be consulted on the second line instead of the first.")
    3068             : 
    3069             : (defun set-auto-mode-1 ()
    3070             :   "Find the -*- spec in the buffer.
    3071             : Call with point at the place to start searching from.
    3072             : If one is found, set point to the beginning and return the position
    3073             : of the end.  Otherwise, return nil; may change point.
    3074             : The variable `inhibit-local-variables-regexps' can cause a -*- spec to
    3075             : be ignored; but `enable-local-variables' and `local-enable-local-variables'
    3076             : have no effect."
    3077         465 :   (let (beg end)
    3078         465 :     (and
    3079             :      ;; Don't look for -*- if this file name matches any
    3080             :      ;; of the regexps in inhibit-local-variables-regexps.
    3081         465 :      (not (inhibit-local-variables-p))
    3082         465 :      (search-forward "-*-" (line-end-position
    3083             :                             ;; If the file begins with "#!"  (exec
    3084             :                             ;; interpreter magic), look for mode frobs
    3085             :                             ;; in the first two lines.  You cannot
    3086             :                             ;; necessarily put them in the first line
    3087             :                             ;; of such a file without screwing up the
    3088             :                             ;; interpreter invocation.  The same holds
    3089             :                             ;; for '\" in man pages (preprocessor
    3090             :                             ;; magic for the `man' program).
    3091         465 :                             (and (looking-at file-auto-mode-skip) 2)) t)
    3092         270 :      (progn
    3093         270 :        (skip-chars-forward " \t")
    3094         270 :        (setq beg (point))
    3095         270 :        (search-forward "-*-" (line-end-position) t))
    3096         270 :      (progn
    3097         270 :        (forward-char -3)
    3098         270 :        (skip-chars-backward " \t")
    3099         270 :        (setq end (point))
    3100         270 :        (goto-char beg)
    3101         465 :        end))))
    3102             : 
    3103             : ;;; Handling file local variables
    3104             : 
    3105             : (defvar ignored-local-variables
    3106             :   '(ignored-local-variables safe-local-variable-values
    3107             :     file-local-variables-alist dir-local-variables-alist)
    3108             :   "Variables to be ignored in a file's local variable spec.")
    3109             : (put 'ignored-local-variables 'risky-local-variable t)
    3110             : 
    3111             : (defvar hack-local-variables-hook nil
    3112             :   "Normal hook run after processing a file's local variables specs.
    3113             : Major modes can use this to examine user-specified local variables
    3114             : in order to initialize other data structure based on them.")
    3115             : 
    3116             : (defcustom safe-local-variable-values nil
    3117             :   "List variable-value pairs that are considered safe.
    3118             : Each element is a cons cell (VAR . VAL), where VAR is a variable
    3119             : symbol and VAL is a value that is considered safe."
    3120             :   :risky t
    3121             :   :group 'find-file
    3122             :   :type 'alist)
    3123             : 
    3124             : (defcustom safe-local-eval-forms
    3125             :   ;; This should be here at least as long as Emacs supports write-file-hooks.
    3126             :   '((add-hook 'write-file-hooks 'time-stamp)
    3127             :     (add-hook 'write-file-functions 'time-stamp)
    3128             :     (add-hook 'before-save-hook 'time-stamp nil t)
    3129             :     (add-hook 'before-save-hook 'delete-trailing-whitespace nil t))
    3130             :   "Expressions that are considered safe in an `eval:' local variable.
    3131             : Add expressions to this list if you want Emacs to evaluate them, when
    3132             : they appear in an `eval' local variable specification, without first
    3133             : asking you for confirmation."
    3134             :   :risky t
    3135             :   :group 'find-file
    3136             :   :version "24.1"                     ; added write-file-hooks
    3137             :   :type '(repeat sexp))
    3138             : 
    3139             : ;; Risky local variables:
    3140             : (mapc (lambda (var) (put var 'risky-local-variable t))
    3141             :       '(after-load-alist
    3142             :         buffer-auto-save-file-name
    3143             :         buffer-file-name
    3144             :         buffer-file-truename
    3145             :         buffer-undo-list
    3146             :         debugger
    3147             :         default-text-properties
    3148             :         eval
    3149             :         exec-directory
    3150             :         exec-path
    3151             :         file-name-handler-alist
    3152             :         frame-title-format
    3153             :         global-mode-string
    3154             :         header-line-format
    3155             :         icon-title-format
    3156             :         inhibit-quit
    3157             :         load-path
    3158             :         max-lisp-eval-depth
    3159             :         max-specpdl-size
    3160             :         minor-mode-map-alist
    3161             :         minor-mode-overriding-map-alist
    3162             :         mode-line-format
    3163             :         mode-name
    3164             :         overriding-local-map
    3165             :         overriding-terminal-local-map
    3166             :         process-environment
    3167             :         standard-input
    3168             :         standard-output
    3169             :         unread-command-events))
    3170             : 
    3171             : ;; Safe local variables:
    3172             : ;;
    3173             : ;; For variables defined by major modes, the safety declarations can go into
    3174             : ;; the major mode's file, since that will be loaded before file variables are
    3175             : ;; processed.
    3176             : ;;
    3177             : ;; For variables defined by minor modes, put the safety declarations in the
    3178             : ;; file defining the minor mode after the defcustom/defvar using an autoload
    3179             : ;; cookie, e.g.:
    3180             : ;;
    3181             : ;;   ;;;###autoload(put 'variable 'safe-local-variable 'stringp)
    3182             : ;;
    3183             : ;; Otherwise, when Emacs visits a file specifying that local variable, the
    3184             : ;; minor mode file may not be loaded yet.
    3185             : ;;
    3186             : ;; For variables defined in the C source code the declaration should go here:
    3187             : 
    3188             : (dolist (pair
    3189             :          '((buffer-read-only        . booleanp) ;; C source code
    3190             :            (default-directory       . stringp)  ;; C source code
    3191             :            (fill-column             . integerp) ;; C source code
    3192             :            (indent-tabs-mode        . booleanp) ;; C source code
    3193             :            (left-margin             . integerp) ;; C source code
    3194             :            (no-update-autoloads     . booleanp)
    3195             :            (lexical-binding      . booleanp)      ;; C source code
    3196             :            (tab-width               . integerp)   ;; C source code
    3197             :            (truncate-lines          . booleanp)   ;; C source code
    3198             :            (word-wrap               . booleanp)   ;; C source code
    3199             :            (bidi-display-reordering . booleanp))) ;; C source code
    3200             :   (put (car pair) 'safe-local-variable (cdr pair)))
    3201             : 
    3202             : (put 'bidi-paragraph-direction 'safe-local-variable
    3203             :      (lambda (v) (memq v '(nil right-to-left left-to-right))))
    3204             : 
    3205             : (put 'c-set-style 'safe-local-eval-function t)
    3206             : 
    3207             : (defvar file-local-variables-alist nil
    3208             :   "Alist of file-local variable settings in the current buffer.
    3209             : Each element in this list has the form (VAR . VALUE), where VAR
    3210             : is a file-local variable (a symbol) and VALUE is the value
    3211             : specified.  The actual value in the buffer may differ from VALUE,
    3212             : if it is changed by the major or minor modes, or by the user.")
    3213             : (make-variable-buffer-local 'file-local-variables-alist)
    3214             : (put 'file-local-variables-alist 'permanent-local t)
    3215             : 
    3216             : (defvar dir-local-variables-alist nil
    3217             :   "Alist of directory-local variable settings in the current buffer.
    3218             : Each element in this list has the form (VAR . VALUE), where VAR
    3219             : is a directory-local variable (a symbol) and VALUE is the value
    3220             : specified in .dir-locals.el.  The actual value in the buffer
    3221             : may differ from VALUE, if it is changed by the major or minor modes,
    3222             : or by the user.")
    3223             : (make-variable-buffer-local 'dir-local-variables-alist)
    3224             : 
    3225             : (defvar before-hack-local-variables-hook nil
    3226             :   "Normal hook run before setting file-local variables.
    3227             : It is called after checking for unsafe/risky variables and
    3228             : setting `file-local-variables-alist', and before applying the
    3229             : variables stored in `file-local-variables-alist'.  A hook
    3230             : function is allowed to change the contents of this alist.
    3231             : 
    3232             : This hook is called only if there is at least one file-local
    3233             : variable to set.")
    3234             : 
    3235             : (defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars dir-name)
    3236             :   "Get confirmation before setting up local variable values.
    3237             : ALL-VARS is the list of all variables to be set up.
    3238             : UNSAFE-VARS is the list of those that aren't marked as safe or risky.
    3239             : RISKY-VARS is the list of those that are marked as risky.
    3240             : If these settings come from directory-local variables, then
    3241             : DIR-NAME is the name of the associated directory.  Otherwise it is nil."
    3242           0 :   (unless noninteractive
    3243           0 :     (let ((name (cond (dir-name)
    3244           0 :                       (buffer-file-name
    3245           0 :                        (file-name-nondirectory buffer-file-name))
    3246           0 :                       ((concat "buffer " (buffer-name)))))
    3247           0 :           (offer-save (and (eq enable-local-variables t)
    3248           0 :                            unsafe-vars))
    3249           0 :           (buf (get-buffer-create "*Local Variables*")))
    3250             :       ;; Set up the contents of the *Local Variables* buffer.
    3251           0 :       (with-current-buffer buf
    3252           0 :         (erase-buffer)
    3253           0 :         (cond
    3254           0 :          (unsafe-vars
    3255           0 :           (insert "The local variables list in " name
    3256             :                   "\ncontains values that may not be safe (*)"
    3257           0 :                   (if risky-vars
    3258             :                       ", and variables that are risky (**)."
    3259           0 :                     ".")))
    3260           0 :          (risky-vars
    3261           0 :           (insert "The local variables list in " name
    3262           0 :                   "\ncontains variables that are risky (**)."))
    3263             :          (t
    3264           0 :           (insert "A local variables list is specified in " name ".")))
    3265           0 :         (insert "\n\nDo you want to apply it?  You can type
    3266             : y  -- to apply the local variables list.
    3267           0 : n  -- to ignore the local variables list.")
    3268           0 :         (if offer-save
    3269           0 :             (insert "
    3270             : !  -- to apply the local variables list, and permanently mark these
    3271           0 :       values (*) as safe (in the future, they will be set automatically.)\n\n")
    3272           0 :           (insert "\n\n"))
    3273           0 :         (dolist (elt all-vars)
    3274           0 :           (cond ((member elt unsafe-vars)
    3275           0 :                  (insert "  * "))
    3276           0 :                 ((member elt risky-vars)
    3277           0 :                  (insert " ** "))
    3278             :                 (t
    3279           0 :                  (insert "    ")))
    3280           0 :           (princ (car elt) buf)
    3281           0 :           (insert " : ")
    3282             :           ;; Make strings with embedded whitespace easier to read.
    3283           0 :           (let ((print-escape-newlines t))
    3284           0 :             (prin1 (cdr elt) buf))
    3285           0 :           (insert "\n"))
    3286           0 :         (set (make-local-variable 'cursor-type) nil)
    3287           0 :         (set-buffer-modified-p nil)
    3288           0 :         (goto-char (point-min)))
    3289             : 
    3290             :       ;; Display the buffer and read a choice.
    3291           0 :       (save-window-excursion
    3292           0 :         (pop-to-buffer buf)
    3293           0 :         (let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
    3294           0 :                (prompt (format "Please type %s%s: "
    3295           0 :                                (if offer-save "y, n, or !" "y or n")
    3296           0 :                                (if (< (line-number-at-pos (point-max))
    3297           0 :                                       (window-body-height))
    3298             :                                    ""
    3299           0 :                                  (push ?\C-v exit-chars)
    3300           0 :                                  ", or C-v to scroll")))
    3301             :                char)
    3302           0 :           (if offer-save (push ?! exit-chars))
    3303           0 :           (while (null char)
    3304           0 :             (setq char (read-char-choice prompt exit-chars t))
    3305           0 :             (when (eq char ?\C-v)
    3306           0 :               (condition-case nil
    3307           0 :                   (scroll-up)
    3308           0 :                 (error (goto-char (point-min))
    3309           0 :                        (recenter 1)))
    3310           0 :               (setq char nil)))
    3311           0 :           (when (and offer-save (= char ?!) unsafe-vars)
    3312           0 :             (customize-push-and-save 'safe-local-variable-values unsafe-vars))
    3313           0 :           (prog1 (memq char '(?! ?\s ?y))
    3314           0 :             (quit-window t)))))))
    3315             : 
    3316             : (defconst hack-local-variable-regexp
    3317             :   "[ \t]*\\([^][;\"'?()\\ \t\n]+\\)[ \t]*:[ \t]*")
    3318             : 
    3319             : (defun hack-local-variables-prop-line (&optional handle-mode)
    3320             :   "Return local variables specified in the -*- line.
    3321             : Usually returns an alist of elements (VAR . VAL), where VAR is a
    3322             : variable and VAL is the specified value.  Ignores any
    3323             : specification for `coding:', and sometimes for `mode' (which
    3324             : should have already been handled by `set-auto-coding' and
    3325             : `set-auto-mode', respectively).  Return nil if the -*- line is
    3326             : malformed.
    3327             : 
    3328             : If HANDLE-MODE is nil, we return the alist of all the local
    3329             : variables in the line except `coding' as described above.  If it
    3330             : is neither nil nor t, we do the same, except that any settings of
    3331             : `mode' and `coding' are ignored.  If HANDLE-MODE is t, we ignore
    3332             : all settings in the line except for `mode', which \(if present) we
    3333             : return as the symbol specifying the mode."
    3334         296 :   (catch 'malformed-line
    3335         296 :     (save-excursion
    3336         296 :       (goto-char (point-min))
    3337         296 :       (let ((end (set-auto-mode-1))
    3338             :             result)
    3339         296 :         (cond ((not end)
    3340             :                nil)
    3341         166 :               ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
    3342             :                ;; Simple form: "-*- MODENAME -*-".
    3343           0 :                (if (eq handle-mode t)
    3344           0 :                    (intern (concat (match-string 1) "-mode"))))
    3345             :               (t
    3346             :                ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
    3347             :                ;; (last ";" is optional).
    3348             :                ;; If HANDLE-MODE is t, just check for `mode'.
    3349             :                ;; Otherwise, parse the -*- line into the RESULT alist.
    3350         332 :                (while (not (or (and (eq handle-mode t) result)
    3351         332 :                                (>= (point) end)))
    3352         166 :                  (unless (looking-at hack-local-variable-regexp)
    3353           0 :                    (message "Malformed mode-line: %S"
    3354           0 :                             (buffer-substring-no-properties (point) end))
    3355         166 :                    (throw 'malformed-line nil))
    3356         166 :                  (goto-char (match-end 0))
    3357             :                  ;; There used to be a downcase here,
    3358             :                  ;; but the manual didn't say so,
    3359             :                  ;; and people want to set var names that aren't all lc.
    3360         166 :                  (let* ((key (intern (match-string 1)))
    3361         166 :                         (val (save-restriction
    3362         166 :                                (narrow-to-region (point) end)
    3363         166 :                                (let ((read-circle nil))
    3364         166 :                                  (read (current-buffer)))))
    3365             :                         ;; It is traditional to ignore
    3366             :                         ;; case when checking for `mode' in set-auto-mode,
    3367             :                         ;; so we must do that here as well.
    3368             :                         ;; That is inconsistent, but we're stuck with it.
    3369             :                         ;; The same can be said for `coding' in set-auto-coding.
    3370         166 :                         (keyname (downcase (symbol-name key))))
    3371         166 :                    (cond
    3372         166 :                     ((eq handle-mode t)
    3373          83 :                      (and (equal keyname "mode")
    3374           0 :                           (setq result
    3375           0 :                                 (intern (concat (downcase (symbol-name val))
    3376          83 :                                                 "-mode")))))
    3377          83 :                     ((equal keyname "coding"))
    3378             :                     (t
    3379          62 :                      (when (or (not handle-mode)
    3380          62 :                                (not (equal keyname "mode")))
    3381          62 :                        (condition-case nil
    3382          62 :                            (push (cons (cond ((eq key 'eval) 'eval)
    3383             :                                              ;; Downcase "Mode:".
    3384          62 :                                              ((equal keyname "mode") 'mode)
    3385          62 :                                              (t (indirect-variable key)))
    3386          62 :                                        val)
    3387         124 :                                  result)
    3388         166 :                          (error nil)))))
    3389         166 :                    (skip-chars-forward " \t;")))
    3390         296 :                result))))))
    3391             : 
    3392             : (defun hack-local-variables-filter (variables dir-name)
    3393             :   "Filter local variable settings, querying the user if necessary.
    3394             : VARIABLES is the alist of variable-value settings.  This alist is
    3395             :  filtered based on the values of `ignored-local-variables',
    3396             :  `enable-local-eval', `enable-local-variables', and (if necessary)
    3397             :  user interaction.  The results are added to
    3398             :  `file-local-variables-alist', without applying them.
    3399             : If these settings come from directory-local variables, then
    3400             : DIR-NAME is the name of the associated directory.  Otherwise it is nil."
    3401             :   ;; Find those variables that we may want to save to
    3402             :   ;; `safe-local-variable-values'.
    3403         296 :   (let (all-vars risky-vars unsafe-vars)
    3404         296 :     (dolist (elt variables)
    3405         713 :       (let ((var (car elt))
    3406         713 :             (val (cdr elt)))
    3407         713 :         (cond ((memq var ignored-local-variables)
    3408             :                ;; Ignore any variable in `ignored-local-variables'.
    3409             :                nil)
    3410             :               ;; Obey `enable-local-eval'.
    3411         713 :               ((eq var 'eval)
    3412           0 :                (when enable-local-eval
    3413           0 :                  (let ((safe (or (hack-one-local-variable-eval-safep val)
    3414             :                                  ;; In case previously marked safe (bug#5636).
    3415           0 :                                  (safe-local-variable-p var val))))
    3416             :                    ;; If not safe and e-l-v = :safe, ignore totally.
    3417           0 :                    (when (or safe (not (eq enable-local-variables :safe)))
    3418           0 :                      (push elt all-vars)
    3419           0 :                      (or (eq enable-local-eval t)
    3420           0 :                          safe
    3421           0 :                          (push elt unsafe-vars))))))
    3422             :               ;; Ignore duplicates (except `mode') in the present list.
    3423         713 :               ((and (assq var all-vars) (not (eq var 'mode))) nil)
    3424             :               ;; Accept known-safe variables.
    3425         713 :               ((or (memq var '(mode unibyte coding))
    3426         713 :                    (safe-local-variable-p var val))
    3427        1426 :                (push elt all-vars))
    3428             :               ;; The variable is either risky or unsafe:
    3429           0 :               ((not (eq enable-local-variables :safe))
    3430           0 :                (push elt all-vars)
    3431           0 :                (if (risky-local-variable-p var val)
    3432           0 :                    (push elt risky-vars)
    3433         713 :                  (push elt unsafe-vars))))))
    3434         296 :     (and all-vars
    3435             :          ;; Query, unless all vars are safe or user wants no querying.
    3436         229 :          (or (and (eq enable-local-variables t)
    3437         229 :                   (null unsafe-vars)
    3438         229 :                   (null risky-vars))
    3439           0 :              (memq enable-local-variables '(:all :safe))
    3440           0 :              (hack-local-variables-confirm all-vars unsafe-vars
    3441         229 :                                            risky-vars dir-name))
    3442         229 :          (dolist (elt all-vars)
    3443         713 :            (unless (memq (car elt) '(eval mode))
    3444         713 :              (unless dir-name
    3445         121 :                (setq dir-local-variables-alist
    3446         713 :                      (assq-delete-all (car elt) dir-local-variables-alist)))
    3447         713 :              (setq file-local-variables-alist
    3448         713 :                    (assq-delete-all (car elt) file-local-variables-alist)))
    3449        1426 :            (push elt file-local-variables-alist)))))
    3450             : 
    3451             : ;; TODO?  Warn once per file rather than once per session?
    3452             : (defvar hack-local-variables--warned-lexical nil)
    3453             : 
    3454             : (defun hack-local-variables (&optional handle-mode)
    3455             :   "Parse and put into effect this buffer's local variables spec.
    3456             : Uses `hack-local-variables-apply' to apply the variables.
    3457             : 
    3458             : If HANDLE-MODE is nil, we apply all the specified local
    3459             : variables.  If HANDLE-MODE is neither nil nor t, we do the same,
    3460             : except that any settings of `mode' are ignored.
    3461             : 
    3462             : If HANDLE-MODE is t, all we do is check whether a \"mode:\"
    3463             : is specified, and return the corresponding mode symbol, or nil.
    3464             : In this case, we try to ignore minor-modes, and only return a
    3465             : major-mode.
    3466             : 
    3467             : If `enable-local-variables' or `local-enable-local-variables' is nil,
    3468             : this function does nothing.  If `inhibit-local-variables-regexps'
    3469             : applies to the file in question, the file is not scanned for
    3470             : local variables, but directory-local variables may still be applied."
    3471             :   ;; We don't let inhibit-local-variables-p influence the value of
    3472             :   ;; enable-local-variables, because then it would affect dir-local
    3473             :   ;; variables.  We don't want to search eg tar files for file local
    3474             :   ;; variable sections, but there is no reason dir-locals cannot apply
    3475             :   ;; to them.  The real meaning of inhibit-local-variables-p is "do
    3476             :   ;; not scan this file for local variables".
    3477         296 :   (let ((enable-local-variables
    3478         296 :          (and local-enable-local-variables enable-local-variables))
    3479             :         result)
    3480         296 :     (unless (eq handle-mode t)
    3481         148 :       (setq file-local-variables-alist nil)
    3482         148 :       (with-demoted-errors "Directory-local variables error: %s"
    3483             :         ;; Note this is a no-op if enable-local-variables is nil.
    3484         296 :         (hack-dir-local-variables)))
    3485             :     ;; This entire function is basically a no-op if enable-local-variables
    3486             :     ;; is nil.  All it does is set file-local-variables-alist to nil.
    3487         296 :     (when enable-local-variables
    3488             :       ;; This part used to ignore enable-local-variables when handle-mode
    3489             :       ;; was t.  That was inappropriate, eg consider the
    3490             :       ;; (artificial) example of:
    3491             :       ;; (setq local-enable-local-variables nil)
    3492             :       ;; Open a file foo.txt that contains "mode: sh".
    3493             :       ;; It correctly opens in text-mode.
    3494             :       ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode.
    3495         296 :       (unless (or (inhibit-local-variables-p)
    3496             :                   ;; If HANDLE-MODE is t, and the prop line specifies a
    3497             :                   ;; mode, then we're done, and have no need to scan further.
    3498         296 :                   (and (setq result (hack-local-variables-prop-line
    3499         296 :                                      handle-mode))
    3500         296 :                        (eq handle-mode t)))
    3501             :         ;; Look for "Local variables:" line in last page.
    3502         296 :         (save-excursion
    3503         296 :           (goto-char (point-max))
    3504         296 :           (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
    3505         296 :                            'move)
    3506         296 :           (when (let ((case-fold-search t))
    3507         296 :                   (search-forward "Local Variables:" nil t))
    3508          46 :             (skip-chars-forward " \t")
    3509             :             ;; suffix is what comes after "local variables:" in its line.
    3510             :             ;; prefix is what comes before "local variables:" in its line.
    3511          46 :             (let ((suffix
    3512          46 :                    (concat
    3513          46 :                     (regexp-quote (buffer-substring (point)
    3514          46 :                                                     (line-end-position)))
    3515          46 :                     "$"))
    3516             :                   (prefix
    3517          46 :                    (concat "^" (regexp-quote
    3518          46 :                                 (buffer-substring (line-beginning-position)
    3519          46 :                                                   (match-beginning 0))))))
    3520             : 
    3521          46 :               (forward-line 1)
    3522          46 :               (let ((startpos (point))
    3523             :                     endpos
    3524          46 :                     (thisbuf (current-buffer)))
    3525          46 :                 (save-excursion
    3526          46 :                   (unless (let ((case-fold-search t))
    3527          46 :                             (re-search-forward
    3528          46 :                              (concat prefix "[ \t]*End:[ \t]*" suffix)
    3529          46 :                              nil t))
    3530             :                     ;; This used to be an error, but really all it means is
    3531             :                     ;; that this may simply not be a local-variables section,
    3532             :                     ;; so just ignore it.
    3533          46 :                     (message "Local variables list is not properly terminated"))
    3534          46 :                   (beginning-of-line)
    3535          46 :                   (setq endpos (point)))
    3536             : 
    3537          46 :                 (with-temp-buffer
    3538          46 :                   (insert-buffer-substring thisbuf startpos endpos)
    3539          46 :                   (goto-char (point-min))
    3540          46 :                   (subst-char-in-region (point) (point-max) ?\^m ?\n)
    3541         208 :                   (while (not (eobp))
    3542             :                     ;; Discard the prefix.
    3543         162 :                     (if (looking-at prefix)
    3544         162 :                         (delete-region (point) (match-end 0))
    3545         162 :                       (error "Local variables entry is missing the prefix"))
    3546         162 :                     (end-of-line)
    3547             :                     ;; Discard the suffix.
    3548         162 :                     (if (looking-back suffix (line-beginning-position))
    3549         162 :                         (delete-region (match-beginning 0) (point))
    3550         162 :                       (error "Local variables entry is missing the suffix"))
    3551         162 :                     (forward-line 1))
    3552          46 :                   (goto-char (point-min))
    3553             : 
    3554         206 :                   (while (not (or (eobp)
    3555         206 :                                   (and (eq handle-mode t) result)))
    3556             :                     ;; Find the variable name;
    3557         160 :                     (unless (looking-at hack-local-variable-regexp)
    3558           0 :                       (error "Malformed local variable line: %S"
    3559           0 :                              (buffer-substring-no-properties
    3560         160 :                               (point) (line-end-position))))
    3561         160 :                     (goto-char (match-end 1))
    3562         160 :                     (let* ((str (match-string 1))
    3563         160 :                            (var (intern str))
    3564             :                            val val2)
    3565         160 :                       (and (equal (downcase (symbol-name var)) "mode")
    3566         160 :                            (setq var 'mode))
    3567             :                       ;; Read the variable value.
    3568         160 :                       (skip-chars-forward "^:")
    3569         160 :                       (forward-char 1)
    3570         160 :                       (let ((read-circle nil))
    3571         160 :                         (setq val (read (current-buffer))))
    3572         160 :                       (if (eq handle-mode t)
    3573          79 :                           (and (eq var 'mode)
    3574             :                                ;; Specifying minor-modes via mode: is
    3575             :                                ;; deprecated, but try to reject them anyway.
    3576           2 :                                (not (string-match
    3577             :                                      "-minor\\'"
    3578           2 :                                      (setq val2 (downcase (symbol-name val)))))
    3579          79 :                                (setq result (intern (concat val2 "-mode"))))
    3580          81 :                         (cond ((eq var 'coding))
    3581          61 :                               ((eq var 'lexical-binding)
    3582           0 :                                (unless hack-local-variables--warned-lexical
    3583           0 :                                  (setq hack-local-variables--warned-lexical t)
    3584           0 :                                  (display-warning
    3585             :                                   'files
    3586           0 :                                   (format-message
    3587             :                                    "%s: `lexical-binding' at end of file unreliable"
    3588           0 :                                    (file-name-nondirectory
    3589             :                                     ;; We are called from
    3590             :                                     ;; 'with-temp-buffer', so we need
    3591             :                                     ;; to use 'thisbuf's name in the
    3592             :                                     ;; warning message.
    3593           0 :                                     (or (buffer-file-name thisbuf) ""))))))
    3594          61 :                               ((and (eq var 'mode) handle-mode))
    3595             :                               (t
    3596          59 :                                (ignore-errors
    3597          59 :                                  (push (cons (if (eq var 'eval)
    3598             :                                                  'eval
    3599          59 :                                                (indirect-variable var))
    3600         160 :                                              val) result))))))
    3601         296 :                     (forward-line 1))))))))
    3602             :       ;; Now we've read all the local variables.
    3603             :       ;; If HANDLE-MODE is t, return whether the mode was specified.
    3604         296 :       (if (eq handle-mode t) result
    3605             :         ;; Otherwise, set the variables.
    3606         148 :         (hack-local-variables-filter result nil)
    3607         296 :         (hack-local-variables-apply)))))
    3608             : 
    3609             : (defun hack-local-variables-apply ()
    3610             :   "Apply the elements of `file-local-variables-alist'.
    3611             : If there are any elements, runs `before-hack-local-variables-hook',
    3612             : then calls `hack-one-local-variable' to apply the alist elements one by one.
    3613             : Finishes by running `hack-local-variables-hook', regardless of whether
    3614             : the alist is empty or not.
    3615             : 
    3616             : Note that this function ignores a `mode' entry if it specifies the same
    3617             : major mode as the buffer already has."
    3618         226 :   (when file-local-variables-alist
    3619             :     ;; Any 'evals must run in the Right sequence.
    3620         173 :     (setq file-local-variables-alist
    3621         173 :           (nreverse file-local-variables-alist))
    3622         173 :     (run-hooks 'before-hack-local-variables-hook)
    3623         173 :     (dolist (elt file-local-variables-alist)
    3624         763 :       (hack-one-local-variable (car elt) (cdr elt))))
    3625         226 :   (run-hooks 'hack-local-variables-hook))
    3626             : 
    3627             : (defun safe-local-variable-p (sym val)
    3628             :   "Non-nil if SYM is safe as a file-local variable with value VAL.
    3629             : It is safe if any of these conditions are met:
    3630             : 
    3631             :  * There is a matching entry (SYM . VAL) in the
    3632             :    `safe-local-variable-values' user option.
    3633             : 
    3634             :  * The `safe-local-variable' property of SYM is a function that
    3635             :    evaluates to a non-nil value with VAL as an argument."
    3636         713 :   (or (member (cons sym val) safe-local-variable-values)
    3637         713 :       (let ((safep (get sym 'safe-local-variable)))
    3638         713 :         (and (functionp safep)
    3639             :              ;; If the function signals an error, that means it
    3640             :              ;; can't assure us that the value is safe.
    3641         713 :              (with-demoted-errors (funcall safep val))))))
    3642             : 
    3643             : (defun risky-local-variable-p (sym &optional _ignored)
    3644             :   "Non-nil if SYM could be dangerous as a file-local variable.
    3645             : It is dangerous if either of these conditions are met:
    3646             : 
    3647             :  * Its `risky-local-variable' property is non-nil.
    3648             : 
    3649             :  * Its name ends with \"hook(s)\", \"function(s)\", \"form(s)\", \"map\",
    3650             :    \"program\", \"command(s)\", \"predicate(s)\", \"frame-alist\",
    3651             :    \"mode-alist\", \"font-lock-(syntactic-)keyword*\",
    3652             :    \"map-alist\", or \"bindat-spec\"."
    3653             :   ;; If this is an alias, check the base name.
    3654           0 :   (condition-case nil
    3655           0 :       (setq sym (indirect-variable sym))
    3656           0 :     (error nil))
    3657           0 :   (or (get sym 'risky-local-variable)
    3658           0 :       (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|\
    3659             : -commands?$\\|-predicates?$\\|font-lock-keywords$\\|font-lock-keywords\
    3660             : -[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|\
    3661           0 : -map$\\|-map-alist$\\|-bindat-spec$" (symbol-name sym))))
    3662             : 
    3663             : (defun hack-one-local-variable-quotep (exp)
    3664           0 :   (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
    3665             : 
    3666             : (defun hack-one-local-variable-constantp (exp)
    3667           0 :   (or (and (not (symbolp exp)) (not (consp exp)))
    3668           0 :       (memq exp '(t nil))
    3669           0 :       (keywordp exp)
    3670           0 :       (hack-one-local-variable-quotep exp)))
    3671             : 
    3672             : (defun hack-one-local-variable-eval-safep (exp)
    3673             :   "Return t if it is safe to eval EXP when it is found in a file."
    3674           0 :   (or (not (consp exp))
    3675             :       ;; Detect certain `put' expressions.
    3676           0 :       (and (eq (car exp) 'put)
    3677           0 :            (hack-one-local-variable-quotep (nth 1 exp))
    3678           0 :            (hack-one-local-variable-quotep (nth 2 exp))
    3679           0 :            (let ((prop (nth 1 (nth 2 exp)))
    3680           0 :                  (val (nth 3 exp)))
    3681           0 :              (cond ((memq prop '(lisp-indent-hook
    3682             :                                  lisp-indent-function
    3683           0 :                                  scheme-indent-function))
    3684             :                     ;; Only allow safe values (not functions).
    3685           0 :                     (or (numberp val)
    3686           0 :                         (and (hack-one-local-variable-quotep val)
    3687           0 :                              (eq (nth 1 val) 'defun))))
    3688           0 :                    ((eq prop 'edebug-form-spec)
    3689             :                     ;; Only allow indirect form specs.
    3690             :                     ;; During bootstrapping, edebug-basic-spec might not be
    3691             :                     ;; defined yet.
    3692           0 :                     (and (fboundp 'edebug-basic-spec)
    3693           0 :                          (hack-one-local-variable-quotep val)
    3694           0 :                          (edebug-basic-spec (nth 1 val)))))))
    3695             :       ;; Allow expressions that the user requested.
    3696           0 :       (member exp safe-local-eval-forms)
    3697             :       ;; Certain functions can be allowed with safe arguments
    3698             :       ;; or can specify verification functions to try.
    3699           0 :       (and (symbolp (car exp))
    3700             :            ;; Allow (minor)-modes calls with no arguments.
    3701             :            ;; This obsoletes the use of "mode:" for such things.  (Bug#8613)
    3702           0 :            (or (and (member (cdr exp) '(nil (1) (0) (-1)))
    3703           0 :                     (string-match "-mode\\'" (symbol-name (car exp))))
    3704           0 :                (let ((prop (get (car exp) 'safe-local-eval-function)))
    3705           0 :                  (cond ((eq prop t)
    3706           0 :                         (let ((ok t))
    3707           0 :                           (dolist (arg (cdr exp))
    3708           0 :                             (unless (hack-one-local-variable-constantp arg)
    3709           0 :                               (setq ok nil)))
    3710           0 :                           ok))
    3711           0 :                        ((functionp prop)
    3712           0 :                         (funcall prop exp))
    3713           0 :                        ((listp prop)
    3714           0 :                         (let ((ok nil))
    3715           0 :                           (dolist (function prop)
    3716           0 :                             (if (funcall function exp)
    3717           0 :                                 (setq ok t)))
    3718           0 :                           ok))))))))
    3719             : 
    3720             : (defun hack-one-local-variable--obsolete (var)
    3721         763 :   (let ((o (get var 'byte-obsolete-variable)))
    3722         763 :     (when o
    3723           0 :       (let ((instead (nth 0 o))
    3724           0 :             (since (nth 2 o)))
    3725           0 :         (message "%s is obsolete%s; %s"
    3726           0 :                  var (if since (format " (since %s)" since))
    3727           0 :                  (if (stringp instead)
    3728           0 :                      (substitute-command-keys instead)
    3729         763 :                    (format-message "use `%s' instead" instead)))))))
    3730             : 
    3731             : (defun hack-one-local-variable (var val)
    3732             :   "Set local variable VAR with value VAL.
    3733             : If VAR is `mode', call `VAL-mode' as a function unless it's
    3734             : already the major mode."
    3735         763 :   (pcase var
    3736             :     (`mode
    3737           0 :      (let ((mode (intern (concat (downcase (symbol-name val))
    3738           0 :                                  "-mode"))))
    3739           0 :        (unless (eq (indirect-function mode)
    3740           0 :                    (indirect-function major-mode))
    3741           0 :          (funcall mode))))
    3742             :     (`eval
    3743           0 :      (pcase val
    3744           0 :        (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook)))
    3745           0 :      (save-excursion (eval val)))
    3746             :     (_
    3747         763 :      (hack-one-local-variable--obsolete var)
    3748             :      ;; Make sure the string has no text properties.
    3749             :      ;; Some text properties can get evaluated in various ways,
    3750             :      ;; so it is risky to put them on with a local variable list.
    3751         763 :      (if (stringp val)
    3752         763 :          (set-text-properties 0 (length val) nil val))
    3753         763 :      (set (make-local-variable var) val))))
    3754             : 
    3755             : ;;; Handling directory-local variables, aka project settings.
    3756             : 
    3757             : (defvar dir-locals-class-alist '()
    3758             :   "Alist mapping directory-local variable classes (symbols) to variable lists.")
    3759             : 
    3760             : (defvar dir-locals-directory-cache '()
    3761             :   "List of cached directory roots for directory-local variable classes.
    3762             : Each element in this list has the form (DIR CLASS MTIME).
    3763             : DIR is the name of the directory.
    3764             : CLASS is the name of a variable class (a symbol).
    3765             : MTIME is the recorded modification time of the directory-local
    3766             : variables file associated with this entry.  This time is a list
    3767             : of integers (the same format as `file-attributes'), and is
    3768             : used to test whether the cache entry is still valid.
    3769             : Alternatively, MTIME can be nil, which means the entry is always
    3770             : considered valid.")
    3771             : 
    3772             : (defsubst dir-locals-get-class-variables (class)
    3773             :   "Return the variable list for CLASS."
    3774         148 :   (cdr (assq class dir-locals-class-alist)))
    3775             : 
    3776             : (defun dir-locals-collect-mode-variables (mode-variables variables)
    3777             :   "Collect directory-local variables from MODE-VARIABLES.
    3778             : VARIABLES is the initial list of variables.
    3779             : Returns the new list."
    3780         296 :   (dolist (pair mode-variables variables)
    3781         592 :     (let* ((variable (car pair))
    3782         592 :            (value (cdr pair))
    3783         592 :            (slot (assq variable variables)))
    3784             :       ;; If variables are specified more than once, only use the last.  (Why?)
    3785             :       ;; The pseudo-variables mode and eval are different (bug#3430).
    3786         592 :       (if (and slot (not (memq variable '(mode eval))))
    3787           0 :           (setcdr slot value)
    3788             :         ;; Need a new cons in case we setcdr later.
    3789        1184 :         (push (cons variable value) variables)))))
    3790             : 
    3791             : (defun dir-locals-collect-variables (class-variables root variables)
    3792             :   "Collect entries from CLASS-VARIABLES into VARIABLES.
    3793             : ROOT is the root directory of the project.
    3794             : Return the new variables list."
    3795         148 :   (let* ((file-name (or (buffer-file-name)
    3796             :                         ;; Handle non-file buffers, too.
    3797         148 :                         (expand-file-name default-directory)))
    3798         148 :          (sub-file-name (if (and file-name
    3799         148 :                                  (file-name-absolute-p file-name))
    3800             :                             ;; FIXME: Why not use file-relative-name?
    3801         148 :                             (substring file-name (length root)))))
    3802         148 :     (condition-case err
    3803         148 :         (dolist (entry class-variables variables)
    3804        1036 :           (let ((key (car entry)))
    3805        1036 :             (cond
    3806        1036 :              ((stringp key)
    3807             :               ;; Don't include this in the previous condition, because we
    3808             :               ;; want to filter all strings before the next condition.
    3809           0 :               (when (and sub-file-name
    3810           0 :                          (>= (length sub-file-name) (length key))
    3811           0 :                          (string-prefix-p key sub-file-name))
    3812           0 :                 (setq variables (dir-locals-collect-variables
    3813           0 :                                  (cdr entry) root variables))))
    3814        1036 :              ((or (not key)
    3815        1036 :                   (derived-mode-p key))
    3816         296 :               (let* ((alist (cdr entry))
    3817         296 :                      (subdirs (assq 'subdirs alist)))
    3818         296 :                 (if (or (not subdirs)
    3819           0 :                         (progn
    3820           0 :                           (setq alist (delq subdirs alist))
    3821           0 :                           (cdr-safe subdirs))
    3822             :                         ;; TODO someone might want to extend this to allow
    3823             :                         ;; integer values for subdir, where N means
    3824             :                         ;; variables apply to this directory and N levels
    3825             :                         ;; below it (0 == nil).
    3826         296 :                         (equal root default-directory))
    3827         296 :                     (setq variables (dir-locals-collect-mode-variables
    3828        1036 :                                      alist variables))))))))
    3829             :       (error
    3830             :        ;; The file's content might be invalid (e.g. have a merge conflict), but
    3831             :        ;; that shouldn't prevent the user from opening the file.
    3832           0 :        (message "%s error: %s" dir-locals-file (error-message-string err))
    3833         148 :        nil))))
    3834             : 
    3835             : (defun dir-locals-set-directory-class (directory class &optional mtime)
    3836             :   "Declare that the DIRECTORY root is an instance of CLASS.
    3837             : DIRECTORY is the name of a directory, a string.
    3838             : CLASS is the name of a project class, a symbol.
    3839             : MTIME is either the modification time of the directory-local
    3840             : variables file that defined this class, or nil.
    3841             : 
    3842             : When a file beneath DIRECTORY is visited, the mode-specific
    3843             : variables from CLASS are applied to the buffer.  The variables
    3844             : for a class are defined using `dir-locals-set-class-variables'."
    3845           0 :   (setq directory (file-name-as-directory (expand-file-name directory)))
    3846           0 :   (unless (assq class dir-locals-class-alist)
    3847           0 :     (error "No such class `%s'" (symbol-name class)))
    3848           0 :   (push (list directory class mtime) dir-locals-directory-cache))
    3849             : 
    3850             : (defun dir-locals-set-class-variables (class variables)
    3851             :   "Map the type CLASS to a list of variable settings.
    3852             : CLASS is the project class, a symbol.  VARIABLES is a list
    3853             : that declares directory-local variables for the class.
    3854             : An element in VARIABLES is either of the form:
    3855             :     (MAJOR-MODE . ALIST)
    3856             : or
    3857             :     (DIRECTORY . LIST)
    3858             : 
    3859             : In the first form, MAJOR-MODE is a symbol, and ALIST is an alist
    3860             : whose elements are of the form (VARIABLE . VALUE).
    3861             : 
    3862             : In the second form, DIRECTORY is a directory name (a string), and
    3863             : LIST is a list of the form accepted by the function.
    3864             : 
    3865             : When a file is visited, the file's class is found.  A directory
    3866             : may be assigned a class using `dir-locals-set-directory-class'.
    3867             : Then variables are set in the file's buffer according to the
    3868             : VARIABLES list of the class.  The list is processed in order.
    3869             : 
    3870             : * If the element is of the form (MAJOR-MODE . ALIST), and the
    3871             :   buffer's major mode is derived from MAJOR-MODE (as determined
    3872             :   by `derived-mode-p'), then all the variables in ALIST are
    3873             :   applied.  A MAJOR-MODE of nil may be used to match any buffer.
    3874             :   `make-local-variable' is called for each variable before it is
    3875             :   set.
    3876             : 
    3877             : * If the element is of the form (DIRECTORY . LIST), and DIRECTORY
    3878             :   is an initial substring of the file's directory, then LIST is
    3879             :   applied by recursively following these rules."
    3880           0 :   (setf (alist-get class dir-locals-class-alist) variables))
    3881             : 
    3882             : (defconst dir-locals-file ".dir-locals.el"
    3883             :   "File that contains directory-local variables.
    3884             : It has to be constant to enforce uniform values across different
    3885             : environments and users.
    3886             : See also `dir-locals-file-2', whose values override this one's.
    3887             : See Info node `(elisp)Directory Local Variables' for details.")
    3888             : 
    3889             : (defconst dir-locals-file-2 ".dir-locals-2.el"
    3890             :   "File that contains directory-local variables.
    3891             : This essentially a second file that can be used like
    3892             : `dir-locals-file', so that users can have specify their personal
    3893             : dir-local variables even if the current directory already has a
    3894             : `dir-locals-file' that is shared with other users (such as in a
    3895             : git repository).
    3896             : See Info node `(elisp)Directory Local Variables' for details.")
    3897             : 
    3898             : (defun dir-locals--all-files (directory)
    3899             :   "Return a list of all readable dir-locals files in DIRECTORY.
    3900             : The returned list is sorted by increasing priority.  That is,
    3901             : values specified in the last file should take precedence over
    3902             : those in the first."
    3903         540 :   (when (file-readable-p directory)
    3904         540 :     (let* ((file-1 (expand-file-name (if (eq system-type 'ms-dos)
    3905           0 :                                         (dosified-file-name dir-locals-file)
    3906         540 :                                       dir-locals-file)
    3907         540 :                                     directory))
    3908         540 :            (file-2 (when (string-match "\\.el\\'" file-1)
    3909         540 :                      (replace-match "-2.el" t nil file-1)))
    3910             :           (out nil))
    3911             :       ;; The order here is important.
    3912         540 :       (dolist (f (list file-2 file-1))
    3913        1080 :         (when (and f
    3914        1080 :                    (file-readable-p f)
    3915         296 :                    (file-regular-p f)
    3916        1080 :                    (not (file-directory-p f)))
    3917        1080 :           (push f out)))
    3918         540 :       out)))
    3919             : 
    3920             : (defun dir-locals-find-file (file)
    3921             :   "Find the directory-local variables for FILE.
    3922             : This searches upward in the directory tree from FILE.
    3923             : It stops at the first directory that has been registered in
    3924             : `dir-locals-directory-cache' or contains a `dir-locals-file'.
    3925             : If it finds an entry in the cache, it checks that it is valid.
    3926             : A cache entry with no modification time element (normally, one that
    3927             : has been assigned directly using `dir-locals-set-directory-class', not
    3928             : set from a file) is always valid.
    3929             : A cache entry based on a `dir-locals-file' is valid if the modification
    3930             : time stored in the cache matches the current file modification time.
    3931             : If not, the cache entry is cleared so that the file will be re-read.
    3932             : 
    3933             : This function returns either:
    3934             :   - nil (no directory local variables found),
    3935             :   - the matching entry from `dir-locals-directory-cache' (a list),
    3936             :   - or the full path to the directory (a string) containing at
    3937             :     least one `dir-locals-file' in the case of no valid cache
    3938             :     entry."
    3939         148 :   (setq file (expand-file-name file))
    3940         148 :   (let* ((locals-dir (locate-dominating-file (file-name-directory file)
    3941         148 :                                              #'dir-locals--all-files))
    3942             :          dir-elt)
    3943             :     ;; `locate-dominating-file' may have abbreviated the name.
    3944         148 :     (when locals-dir
    3945         148 :       (setq locals-dir (expand-file-name locals-dir)))
    3946             :     ;; Find the best cached value in `dir-locals-directory-cache'.
    3947         148 :     (dolist (elt dir-locals-directory-cache)
    3948         148 :       (when (and (string-prefix-p (car elt) file
    3949         148 :                                   (memq system-type
    3950         148 :                                         '(windows-nt cygwin ms-dos)))
    3951         148 :                  (> (length (car elt)) (length (car dir-elt))))
    3952         148 :         (setq dir-elt elt)))
    3953         148 :     (if (and dir-elt
    3954         148 :              (or (null locals-dir)
    3955         148 :                  (<= (length locals-dir)
    3956         148 :                      (length (car dir-elt)))))
    3957             :         ;; Found a potential cache entry.  Check validity.
    3958             :         ;; A cache entry with no MTIME is assumed to always be valid
    3959             :         ;; (ie, set directly, not from a dir-locals file).
    3960             :         ;; Note, we don't bother to check that there is a matching class
    3961             :         ;; element in dir-locals-class-alist, since that's done by
    3962             :         ;; dir-locals-set-directory-class.
    3963         148 :         (if (or (null (nth 2 dir-elt))
    3964         148 :                 (let ((cached-files (dir-locals--all-files (car dir-elt))))
    3965             :                   ;; The entry MTIME should match the most recent
    3966             :                   ;; MTIME among matching files.
    3967         148 :                   (and cached-files
    3968         148 :                        (= (float-time (nth 2 dir-elt))
    3969         148 :                           (apply #'max (mapcar (lambda (f)
    3970         148 :                                                  (float-time
    3971         148 :                                                   (nth 5 (file-attributes f))))
    3972         148 :                                                cached-files))))))
    3973             :             ;; This cache entry is OK.
    3974         148 :             dir-elt
    3975             :           ;; This cache entry is invalid; clear it.
    3976           0 :           (setq dir-locals-directory-cache
    3977           0 :                 (delq dir-elt dir-locals-directory-cache))
    3978             :           ;; Return the first existing dir-locals file.  Might be the same
    3979             :           ;; as dir-elt's, might not (eg latter might have been deleted).
    3980         148 :           locals-dir)
    3981             :       ;; No cache entry.
    3982         148 :       locals-dir)))
    3983             : 
    3984             : (defun dir-locals-read-from-dir (dir)
    3985             :   "Load all variables files in DIR and register a new class and instance.
    3986             : DIR is the absolute name of a directory which must contain at
    3987             : least one dir-local file (which is a file holding variables to
    3988             : apply).
    3989             : Return the new class name, which is a symbol named DIR."
    3990           0 :   (require 'map)
    3991           0 :   (let* ((class-name (intern dir))
    3992           0 :          (files (dir-locals--all-files dir))
    3993             :          (read-circle nil)
    3994             :          (success nil)
    3995             :          (variables))
    3996           0 :     (with-demoted-errors "Error reading dir-locals: %S"
    3997           0 :       (dolist (file files)
    3998           0 :         (with-temp-buffer
    3999           0 :           (insert-file-contents file)
    4000           0 :           (condition-case-unless-debug nil
    4001           0 :               (setq variables
    4002           0 :                     (map-merge-with 'list (lambda (a b) (map-merge 'list a b))
    4003           0 :                                     variables
    4004           0 :                                     (read (current-buffer))))
    4005           0 :             (end-of-file nil))))
    4006           0 :       (setq success t))
    4007           0 :     (dir-locals-set-class-variables class-name variables)
    4008           0 :     (dir-locals-set-directory-class
    4009           0 :      dir class-name
    4010           0 :      (seconds-to-time
    4011           0 :       (if success
    4012           0 :           (apply #'max (mapcar (lambda (file)
    4013           0 :                                  (float-time (nth 5 (file-attributes file))))
    4014           0 :                                files))
    4015             :         ;; If there was a problem, use the values we could get but
    4016             :         ;; don't let the cache prevent future reads.
    4017           0 :         0)))
    4018           0 :     class-name))
    4019             : 
    4020             : (define-obsolete-function-alias 'dir-locals-read-from-file
    4021             :   'dir-locals-read-from-dir "25.1")
    4022             : 
    4023             : (defcustom enable-remote-dir-locals nil
    4024             :   "Non-nil means dir-local variables will be applied to remote files."
    4025             :   :version "24.3"
    4026             :   :type 'boolean
    4027             :   :group 'find-file)
    4028             : 
    4029             : (defvar hack-dir-local-variables--warned-coding nil)
    4030             : 
    4031             : (defun hack-dir-local-variables ()
    4032             :   "Read per-directory local variables for the current buffer.
    4033             : Store the directory-local variables in `dir-local-variables-alist'
    4034             : and `file-local-variables-alist', without applying them.
    4035             : 
    4036             : This does nothing if either `enable-local-variables' or
    4037             : `enable-dir-local-variables' are nil."
    4038         154 :   (when (and enable-local-variables
    4039         154 :              enable-dir-local-variables
    4040         154 :              (or enable-remote-dir-locals
    4041         154 :                  (not (file-remote-p (or (buffer-file-name)
    4042         154 :                                          default-directory)))))
    4043             :     ;; Find the variables file.
    4044         148 :     (let ((dir-or-cache (dir-locals-find-file
    4045         148 :                          (or (buffer-file-name) default-directory)))
    4046             :           (class nil)
    4047             :           (dir-name nil))
    4048         148 :       (cond
    4049         148 :        ((stringp dir-or-cache)
    4050           0 :         (setq dir-name dir-or-cache
    4051           0 :               class (dir-locals-read-from-dir dir-or-cache)))
    4052         148 :        ((consp dir-or-cache)
    4053         148 :         (setq dir-name (nth 0 dir-or-cache))
    4054         148 :         (setq class (nth 1 dir-or-cache))))
    4055         148 :       (when class
    4056         148 :         (let ((variables
    4057         148 :                (dir-locals-collect-variables
    4058         148 :                 (dir-locals-get-class-variables class) dir-name nil)))
    4059         148 :           (when variables
    4060         148 :             (dolist (elt variables)
    4061         592 :               (if (eq (car elt) 'coding)
    4062           0 :                   (unless hack-dir-local-variables--warned-coding
    4063           0 :                     (setq hack-dir-local-variables--warned-coding t)
    4064           0 :                     (display-warning 'files
    4065           0 :                                      "Coding cannot be specified by dir-locals"))
    4066         592 :                 (unless (memq (car elt) '(eval mode))
    4067         592 :                   (setq dir-local-variables-alist
    4068         592 :                         (assq-delete-all (car elt) dir-local-variables-alist)))
    4069        1184 :                 (push elt dir-local-variables-alist)))
    4070         154 :             (hack-local-variables-filter variables dir-name)))))))
    4071             : 
    4072             : (defun hack-dir-local-variables-non-file-buffer ()
    4073             :   "Apply directory-local variables to a non-file buffer.
    4074             : For non-file buffers, such as Dired buffers, directory-local
    4075             : variables are looked for in `default-directory' and its parent
    4076             : directories."
    4077           6 :   (hack-dir-local-variables)
    4078           6 :   (hack-local-variables-apply))
    4079             : 
    4080             : 
    4081             : (defcustom change-major-mode-with-file-name t
    4082             :   "Non-nil means \\[write-file] should set the major mode from the file name.
    4083             : However, the mode will not be changed if
    4084             : \(1) a local variables list or the `-*-' line specifies a major mode, or
    4085             : \(2) the current major mode is a \"special\" mode,
    4086             :     not suitable for ordinary files, or
    4087             : \(3) the new file name does not particularly specify any mode."
    4088             :   :type 'boolean
    4089             :   :group 'editing-basics)
    4090             : 
    4091             : (defun set-visited-file-name (filename &optional no-query along-with-file)
    4092             :   "Change name of file visited in current buffer to FILENAME.
    4093             : This also renames the buffer to correspond to the new file.
    4094             : The next time the buffer is saved it will go in the newly specified file.
    4095             : FILENAME nil or an empty string means mark buffer as not visiting any file.
    4096             : Remember to delete the initial contents of the minibuffer
    4097             : if you wish to pass an empty string as the argument.
    4098             : 
    4099             : The optional second argument NO-QUERY, if non-nil, inhibits asking for
    4100             : confirmation in the case where another buffer is already visiting FILENAME.
    4101             : 
    4102             : The optional third argument ALONG-WITH-FILE, if non-nil, means that
    4103             : the old visited file has been renamed to the new name FILENAME."
    4104             :   (interactive "FSet visited file name: ")
    4105           0 :   (if (buffer-base-buffer)
    4106           0 :       (error "An indirect buffer cannot visit a file"))
    4107           0 :   (let (truename old-try-locals)
    4108           0 :     (if filename
    4109           0 :         (setq filename
    4110           0 :               (if (string-equal filename "")
    4111             :                   nil
    4112           0 :                 (expand-file-name filename))))
    4113           0 :     (if filename
    4114           0 :         (progn
    4115           0 :           (setq truename (file-truename filename))
    4116           0 :           (if find-file-visit-truename
    4117           0 :               (setq filename truename))))
    4118           0 :     (if filename
    4119           0 :         (let ((new-name (file-name-nondirectory filename)))
    4120           0 :           (if (string= new-name "")
    4121           0 :               (error "Empty file name"))))
    4122           0 :     (let ((buffer (and filename (find-buffer-visiting filename))))
    4123           0 :       (and buffer (not (eq buffer (current-buffer)))
    4124           0 :            (not no-query)
    4125           0 :            (not (y-or-n-p (format "A buffer is visiting %s; proceed? "
    4126           0 :                                   filename)))
    4127           0 :            (user-error "Aborted")))
    4128           0 :     (or (equal filename buffer-file-name)
    4129           0 :         (progn
    4130           0 :           (and filename (lock-buffer filename))
    4131           0 :           (unlock-buffer)))
    4132           0 :     (setq old-try-locals (not (inhibit-local-variables-p))
    4133           0 :           buffer-file-name filename)
    4134           0 :     (if filename                        ; make buffer name reflect filename.
    4135           0 :         (let ((new-name (file-name-nondirectory buffer-file-name)))
    4136           0 :           (setq default-directory (file-name-directory buffer-file-name))
    4137             :           ;; If new-name == old-name, renaming would add a spurious <2>
    4138             :           ;; and it's considered as a feature in rename-buffer.
    4139           0 :           (or (string= new-name (buffer-name))
    4140           0 :               (rename-buffer new-name t))))
    4141           0 :     (setq buffer-backed-up nil)
    4142           0 :     (or along-with-file
    4143           0 :         (clear-visited-file-modtime))
    4144             :     ;; Abbreviate the file names of the buffer.
    4145           0 :     (if truename
    4146           0 :         (progn
    4147           0 :           (setq buffer-file-truename (abbreviate-file-name truename))
    4148           0 :           (if find-file-visit-truename
    4149           0 :               (setq buffer-file-name truename))))
    4150           0 :     (setq buffer-file-number
    4151           0 :           (if filename
    4152           0 :               (nthcdr 10 (file-attributes buffer-file-name))
    4153           0 :             nil))
    4154             :     ;; write-file-functions is normally used for things like ftp-find-file
    4155             :     ;; that visit things that are not local files as if they were files.
    4156             :     ;; Changing to visit an ordinary local file instead should flush the hook.
    4157           0 :     (kill-local-variable 'write-file-functions)
    4158           0 :     (kill-local-variable 'local-write-file-hooks)
    4159           0 :     (kill-local-variable 'revert-buffer-function)
    4160           0 :     (kill-local-variable 'backup-inhibited)
    4161             :     ;; If buffer was read-only because of version control,
    4162             :     ;; that reason is gone now, so make it writable.
    4163           0 :     (if vc-mode
    4164           0 :         (setq buffer-read-only nil))
    4165           0 :     (kill-local-variable 'vc-mode)
    4166             :     ;; Turn off backup files for certain file names.
    4167             :     ;; Since this is a permanent local, the major mode won't eliminate it.
    4168           0 :     (and buffer-file-name
    4169           0 :          backup-enable-predicate
    4170           0 :          (not (funcall backup-enable-predicate buffer-file-name))
    4171           0 :          (progn
    4172           0 :            (make-local-variable 'backup-inhibited)
    4173           0 :            (setq backup-inhibited t)))
    4174           0 :     (let ((oauto buffer-auto-save-file-name))
    4175           0 :       (cond ((null filename)
    4176           0 :              (setq buffer-auto-save-file-name nil))
    4177           0 :             ((not buffer-auto-save-file-name)
    4178             :              ;; If auto-save was not already on, turn it on if appropriate.
    4179           0 :              (and buffer-file-name auto-save-default (auto-save-mode t)))
    4180             :             (t
    4181             :              ;; If auto save is on, start using a new name. We
    4182             :              ;; deliberately don't rename or delete the old auto save
    4183             :              ;; for the old visited file name.  This is because
    4184             :              ;; perhaps the user wants to save the new state and then
    4185             :              ;; compare with the previous state from the auto save
    4186             :              ;; file.
    4187           0 :              (setq buffer-auto-save-file-name (make-auto-save-file-name))))
    4188             :       ;; Rename the old auto save file if any.
    4189           0 :       (and oauto buffer-auto-save-file-name
    4190           0 :            (file-exists-p oauto)
    4191           0 :            (rename-file oauto buffer-auto-save-file-name t)))
    4192           0 :     (and buffer-file-name
    4193           0 :          (not along-with-file)
    4194           0 :          (set-buffer-modified-p t))
    4195             :     ;; Update the major mode, if the file name determines it.
    4196           0 :     (condition-case nil
    4197             :         ;; Don't change the mode if it is special.
    4198           0 :         (or (not change-major-mode-with-file-name)
    4199           0 :             (get major-mode 'mode-class)
    4200             :             ;; Don't change the mode if the local variable list specifies it.
    4201             :             ;; The file name can influence whether the local variables apply.
    4202           0 :             (and old-try-locals
    4203             :                  ;; h-l-v also checks it, but might as well be explicit.
    4204           0 :                  (not (inhibit-local-variables-p))
    4205           0 :                  (hack-local-variables t))
    4206             :             ;; TODO consider making normal-mode handle this case.
    4207           0 :             (let ((old major-mode))
    4208           0 :               (set-auto-mode t)
    4209           0 :               (or (eq old major-mode)
    4210           0 :                   (hack-local-variables))))
    4211           0 :     (error nil))))
    4212             : 
    4213             : (defun write-file (filename &optional confirm)
    4214             :   "Write current buffer into file FILENAME.
    4215             : This makes the buffer visit that file, and marks it as not modified.
    4216             : 
    4217             : If you specify just a directory name as FILENAME, that means to use
    4218             : the default file name but in that directory.  You can also yank
    4219             : the default file name into the minibuffer to edit it, using \\<minibuffer-local-map>\\[next-history-element].
    4220             : 
    4221             : If the buffer is not already visiting a file, the default file name
    4222             : for the output file is the buffer name.
    4223             : 
    4224             : If optional second arg CONFIRM is non-nil, this function
    4225             : asks for confirmation before overwriting an existing file.
    4226             : Interactively, confirmation is required unless you supply a prefix argument."
    4227             : ;;  (interactive "FWrite file: ")
    4228             :   (interactive
    4229           0 :    (list (if buffer-file-name
    4230           0 :              (read-file-name "Write file: "
    4231           0 :                              nil nil nil nil)
    4232           0 :            (read-file-name "Write file: " default-directory
    4233           0 :                            (expand-file-name
    4234           0 :                             (file-name-nondirectory (buffer-name))
    4235           0 :                             default-directory)
    4236           0 :                            nil nil))
    4237           0 :          (not current-prefix-arg)))
    4238           0 :   (or (null filename) (string-equal filename "")
    4239           0 :       (progn
    4240             :         ;; If arg is just a directory,
    4241             :         ;; use the default file name, but in that directory.
    4242           0 :         (if (file-directory-p filename)
    4243           0 :             (setq filename (concat (file-name-as-directory filename)
    4244           0 :                                    (file-name-nondirectory
    4245           0 :                                     (or buffer-file-name (buffer-name))))))
    4246           0 :         (and confirm
    4247           0 :              (file-exists-p filename)
    4248             :              ;; NS does its own confirm dialog.
    4249           0 :              (not (and (eq (framep-on-display) 'ns)
    4250           0 :                        (listp last-nonmenu-event)
    4251           0 :                        use-dialog-box))
    4252           0 :              (or (y-or-n-p (format-message
    4253           0 :                             "File `%s' exists; overwrite? " filename))
    4254           0 :                  (user-error "Canceled")))
    4255           0 :         (set-visited-file-name filename (not confirm))))
    4256           0 :   (set-buffer-modified-p t)
    4257             :   ;; Make buffer writable if file is writable.
    4258           0 :   (and buffer-file-name
    4259           0 :        (file-writable-p buffer-file-name)
    4260           0 :        (setq buffer-read-only nil))
    4261           0 :   (save-buffer)
    4262             :   ;; It's likely that the VC status at the new location is different from
    4263             :   ;; the one at the old location.
    4264           0 :   (vc-refresh-state))
    4265             : 
    4266             : (defun file-extended-attributes (filename)
    4267             :   "Return an alist of extended attributes of file FILENAME.
    4268             : 
    4269             : Extended attributes are platform-specific metadata about the file,
    4270             : such as SELinux context, list of ACL entries, etc."
    4271           0 :   `((acl . ,(file-acl filename))
    4272           0 :     (selinux-context . ,(file-selinux-context filename))))
    4273             : 
    4274             : (defun set-file-extended-attributes (filename attributes)
    4275             :   "Set extended attributes of file FILENAME to ATTRIBUTES.
    4276             : 
    4277             : ATTRIBUTES must be an alist of file attributes as returned by
    4278             : `file-extended-attributes'.
    4279             : Value is t if the function succeeds in setting the attributes."
    4280           0 :   (let (result rv)
    4281           0 :     (dolist (elt attributes)
    4282           0 :       (let ((attr (car elt))
    4283           0 :             (val (cdr elt)))
    4284           0 :         (cond ((eq attr 'acl)
    4285           0 :                (setq rv (set-file-acl filename val)))
    4286           0 :               ((eq attr 'selinux-context)
    4287           0 :                (setq rv (set-file-selinux-context filename val))))
    4288           0 :         (setq result (or result rv))))
    4289             : 
    4290           0 :     result))
    4291             : 
    4292             : (defun backup-buffer ()
    4293             :   "Make a backup of the disk file visited by the current buffer, if appropriate.
    4294             : This is normally done before saving the buffer the first time.
    4295             : 
    4296             : A backup may be done by renaming or by copying; see documentation of
    4297             : variable `make-backup-files'.  If it's done by renaming, then the file is
    4298             : no longer accessible under its old name.
    4299             : 
    4300             : The value is non-nil after a backup was made by renaming.
    4301             : It has the form (MODES EXTENDED-ATTRIBUTES BACKUPNAME).
    4302             : MODES is the result of `file-modes' on the original
    4303             : file; this means that the caller, after saving the buffer, should change
    4304             : the modes of the new file to agree with the old modes.
    4305             : EXTENDED-ATTRIBUTES is the result of `file-extended-attributes'
    4306             : on the original file; this means that the caller, after saving
    4307             : the buffer, should change the extended attributes of the new file
    4308             : to agree with the old attributes.
    4309             : BACKUPNAME is the backup file name, which is the old file renamed."
    4310           0 :   (when (and make-backup-files (not backup-inhibited) (not buffer-backed-up))
    4311           0 :     (let ((attributes (file-attributes buffer-file-name)))
    4312           0 :       (when (and attributes (memq (aref (elt attributes 8) 0) '(?- ?l)))
    4313             :         ;; If specified name is a symbolic link, chase it to the target.
    4314             :         ;; This makes backups in the directory where the real file is.
    4315           0 :         (let* ((real-file-name (file-chase-links buffer-file-name))
    4316           0 :                (backup-info (find-backup-file-name real-file-name)))
    4317           0 :           (when backup-info
    4318           0 :             (let* ((backupname (car backup-info))
    4319           0 :                    (targets (cdr backup-info))
    4320             :                    (old-versions
    4321             :                     ;; If have old versions to maybe delete,
    4322             :                     ;; ask the user to confirm now, before doing anything.
    4323             :                     ;; But don't actually delete til later.
    4324           0 :                     (and targets
    4325           0 :                          (booleanp delete-old-versions)
    4326           0 :                          (or delete-old-versions
    4327           0 :                              (y-or-n-p
    4328           0 :                               (format "Delete excess backup versions of %s? "
    4329           0 :                                       real-file-name)))
    4330           0 :                          targets))
    4331           0 :                    (modes (file-modes buffer-file-name))
    4332             :                    (extended-attributes
    4333           0 :                     (file-extended-attributes buffer-file-name))
    4334             :                    (copy-when-priv-mismatch
    4335           0 :                     backup-by-copying-when-privileged-mismatch)
    4336             :                    (make-copy
    4337           0 :                     (or file-precious-flag backup-by-copying
    4338             :                         ;; Don't rename a suid or sgid file.
    4339           0 :                         (and modes (< 0 (logand modes #o6000)))
    4340           0 :                         (not (file-writable-p
    4341           0 :                               (file-name-directory real-file-name)))
    4342           0 :                         (and backup-by-copying-when-linked
    4343           0 :                              (< 1 (file-nlinks real-file-name)))
    4344           0 :                         (and (or backup-by-copying-when-mismatch
    4345           0 :                                  (and (integerp copy-when-priv-mismatch)
    4346           0 :                                       (let ((attr (file-attributes
    4347           0 :                                                    real-file-name
    4348           0 :                                                    'integer)))
    4349           0 :                                         (<= (nth 2 attr)
    4350           0 :                                             copy-when-priv-mismatch))))
    4351           0 :                              (not (file-ownership-preserved-p real-file-name
    4352           0 :                                                               t)))))
    4353             :                    setmodes)
    4354           0 :               (condition-case ()
    4355           0 :                   (progn
    4356             :                     ;; Actually make the backup file.
    4357           0 :                     (if make-copy
    4358           0 :                         (backup-buffer-copy real-file-name backupname
    4359           0 :                                             modes extended-attributes)
    4360             :                       ;; rename-file should delete old backup.
    4361           0 :                       (rename-file real-file-name backupname t)
    4362           0 :                       (setq setmodes (list modes extended-attributes
    4363           0 :                                            backupname)))
    4364           0 :                     (setq buffer-backed-up t)
    4365             :                     ;; Now delete the old versions, if desired.
    4366           0 :                     (dolist (old-version old-versions)
    4367           0 :                       (delete-file old-version)))
    4368           0 :                 (file-error nil))
    4369             :               ;; If trouble writing the backup, write it in .emacs.d/%backup%.
    4370           0 :               (when (not buffer-backed-up)
    4371           0 :                 (setq backupname (locate-user-emacs-file "%backup%~"))
    4372           0 :                 (message "Cannot write backup file; backing up in %s"
    4373           0 :                          backupname)
    4374           0 :                 (sleep-for 1)
    4375           0 :                 (backup-buffer-copy real-file-name backupname
    4376           0 :                                     modes extended-attributes)
    4377           0 :                 (setq buffer-backed-up t))
    4378           0 :               setmodes)))))))
    4379             : 
    4380             : (defun backup-buffer-copy (from-name to-name modes extended-attributes)
    4381             :   ;; Create temp files with strict access rights.  It's easy to
    4382             :   ;; loosen them later, whereas it's impossible to close the
    4383             :   ;; time-window of loose permissions otherwise.
    4384           0 :   (with-file-modes ?\700
    4385           0 :     (when (condition-case nil
    4386             :               ;; Try to overwrite old backup first.
    4387           0 :               (copy-file from-name to-name t t t)
    4388           0 :             (error t))
    4389           0 :       (while (condition-case nil
    4390           0 :                  (progn
    4391           0 :                    (when (file-exists-p to-name)
    4392           0 :                      (delete-file to-name))
    4393           0 :                    (copy-file from-name to-name nil t t)
    4394           0 :                    nil)
    4395           0 :                (file-already-exists t))
    4396             :         ;; The file was somehow created by someone else between
    4397             :         ;; `delete-file' and `copy-file', so let's try again.
    4398             :         ;; rms says "I think there is also a possible race
    4399             :         ;; condition for making backup files" (emacs-devel 20070821).
    4400           0 :         nil)))
    4401             :   ;; If set-file-extended-attributes fails, fall back on set-file-modes.
    4402           0 :   (unless (and extended-attributes
    4403           0 :                (with-demoted-errors
    4404           0 :                  (set-file-extended-attributes to-name extended-attributes)))
    4405           0 :     (and modes
    4406           0 :          (set-file-modes to-name (logand modes #o1777)))))
    4407             : 
    4408             : (defvar file-name-version-regexp
    4409             :   "\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)"
    4410             :   ;; The last ~[[:digit]]+ matches relative versions in git,
    4411             :   ;; e.g. `foo.js.~HEAD~1~'.
    4412             :   "Regular expression matching the backup/version part of a file name.
    4413             : Used by `file-name-sans-versions'.")
    4414             : 
    4415             : (defun file-name-sans-versions (name &optional keep-backup-version)
    4416             :   "Return file NAME sans backup versions or strings.
    4417             : This is a separate procedure so your site-init or startup file can
    4418             : redefine it.
    4419             : If the optional argument KEEP-BACKUP-VERSION is non-nil,
    4420             : we do not remove backup version numbers, only true file version numbers.
    4421             : See also `file-name-version-regexp'."
    4422        1758 :   (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
    4423        1758 :     (if handler
    4424           0 :         (funcall handler 'file-name-sans-versions name keep-backup-version)
    4425        1758 :       (substring name 0
    4426        1758 :                  (unless keep-backup-version
    4427        1758 :                    (string-match (concat file-name-version-regexp "\\'")
    4428        1758 :                                  name))))))
    4429             : 
    4430             : (defun file-ownership-preserved-p (file &optional group)
    4431             :   "Return t if deleting FILE and rewriting it would preserve the owner.
    4432             : Return also t if FILE does not exist.  If GROUP is non-nil, check whether
    4433             : the group would be preserved too."
    4434          12 :   (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
    4435          12 :     (if handler
    4436          12 :         (funcall handler 'file-ownership-preserved-p file group)
    4437           0 :       (let ((attributes (file-attributes file 'integer)))
    4438             :         ;; Return t if the file doesn't exist, since it's true that no
    4439             :         ;; information would be lost by an (attempted) delete and create.
    4440           0 :         (or (null attributes)
    4441           0 :             (and (or (= (nth 2 attributes) (user-uid))
    4442             :                      ;; Files created on Windows by Administrator (RID=500)
    4443             :                      ;; have the Administrators group (RID=544) recorded as
    4444             :                      ;; their owner.  Rewriting them will still preserve the
    4445             :                      ;; owner.
    4446           0 :                      (and (eq system-type 'windows-nt)
    4447           0 :                           (= (user-uid) 500) (= (nth 2 attributes) 544)))
    4448           0 :                  (or (not group)
    4449             :                      ;; On BSD-derived systems files always inherit the parent
    4450             :                      ;; directory's group, so skip the group-gid test.
    4451           0 :                      (memq system-type '(berkeley-unix darwin gnu/kfreebsd))
    4452           0 :                      (= (nth 3 attributes) (group-gid)))
    4453           0 :                  (let* ((parent (or (file-name-directory file) "."))
    4454           0 :                         (parent-attributes (file-attributes parent 'integer)))
    4455           0 :                    (and parent-attributes
    4456             :                         ;; On some systems, a file created in a setuid directory
    4457             :                         ;; inherits that directory's owner.
    4458           0 :                         (or
    4459           0 :                          (= (nth 2 parent-attributes) (user-uid))
    4460           0 :                          (string-match "^...[^sS]" (nth 8 parent-attributes)))
    4461             :                         ;; On many systems, a file created in a setgid directory
    4462             :                         ;; inherits that directory's group.  On some systems
    4463             :                         ;; this happens even if the setgid bit is not set.
    4464           0 :                         (or (not group)
    4465           0 :                             (= (nth 3 parent-attributes)
    4466          12 :                                (nth 3 attributes)))))))))))
    4467             : 
    4468             : (defun file-name-sans-extension (filename)
    4469             :   "Return FILENAME sans final \"extension\".
    4470             : The extension, in a file name, is the part that begins with the last `.',
    4471             : except that a leading `.' of the file name, if there is one, doesn't count."
    4472          42 :   (save-match-data
    4473          42 :     (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
    4474             :           directory)
    4475          42 :       (if (and (string-match "\\.[^.]*\\'" file)
    4476          42 :                (not (eq 0 (match-beginning 0))))
    4477          42 :           (if (setq directory (file-name-directory filename))
    4478             :               ;; Don't use expand-file-name here; if DIRECTORY is relative,
    4479             :               ;; we don't want to expand it.
    4480           0 :               (concat directory (substring file 0 (match-beginning 0)))
    4481          42 :             (substring file 0 (match-beginning 0)))
    4482          42 :         filename))))
    4483             : 
    4484             : (defun file-name-extension (filename &optional period)
    4485             :   "Return FILENAME's final \"extension\".
    4486             : The extension, in a file name, is the part that begins with the last `.',
    4487             : excluding version numbers and backup suffixes, except that a leading `.'
    4488             : of the file name, if there is one, doesn't count.
    4489             : Return nil for extensionless file names such as `foo'.
    4490             : Return the empty string for file names such as `foo.'.
    4491             : 
    4492             : By default, the returned value excludes the period that starts the
    4493             : extension, but if the optional argument PERIOD is non-nil, the period
    4494             : is included in the value, and in that case, if FILENAME has no
    4495             : extension, the value is \"\"."
    4496         682 :   (save-match-data
    4497         682 :     (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
    4498         682 :       (if (and (string-match "\\.[^.]*\\'" file)
    4499         682 :                (not (eq 0 (match-beginning 0))))
    4500           6 :           (substring file (+ (match-beginning 0) (if period 0 1)))
    4501         676 :         (if period
    4502         682 :             "")))))
    4503             : 
    4504             : (defun file-name-base (&optional filename)
    4505             :   "Return the base name of the FILENAME: no directory, no extension.
    4506             : FILENAME defaults to `buffer-file-name'."
    4507           0 :   (file-name-sans-extension
    4508           0 :    (file-name-nondirectory (or filename (buffer-file-name)))))
    4509             : 
    4510             : (defcustom make-backup-file-name-function
    4511             :   #'make-backup-file-name--default-function
    4512             :   "A function that `make-backup-file-name' uses to create backup file names.
    4513             : The function receives a single argument, the original file name.
    4514             : 
    4515             : If you change this, you may need to change `backup-file-name-p' and
    4516             : `file-name-sans-versions' too.
    4517             : 
    4518             : You could make this buffer-local to do something special for specific files.
    4519             : 
    4520             : For historical reasons, a value of nil means to use the default function.
    4521             : This should not be relied upon.
    4522             : 
    4523             : See also `backup-directory-alist'."
    4524             :   :version "24.4"     ; nil -> make-backup-file-name--default-function
    4525             :   :group 'backup
    4526             :   :type '(choice (const :tag "Deprecated way to get the default function" nil)
    4527             :                  (function :tag "Function")))
    4528             : 
    4529             : (defcustom backup-directory-alist nil
    4530             :   "Alist of filename patterns and backup directory names.
    4531             : Each element looks like (REGEXP . DIRECTORY).  Backups of files with
    4532             : names matching REGEXP will be made in DIRECTORY.  DIRECTORY may be
    4533             : relative or absolute.  If it is absolute, so that all matching files
    4534             : are backed up into the same directory, the file names in this
    4535             : directory will be the full name of the file backed up with all
    4536             : directory separators changed to `!' to prevent clashes.  This will not
    4537             : work correctly if your filesystem truncates the resulting name.
    4538             : 
    4539             : For the common case of all backups going into one directory, the alist
    4540             : should contain a single element pairing \".\" with the appropriate
    4541             : directory name.
    4542             : 
    4543             : If this variable is nil, or it fails to match a filename, the backup
    4544             : is made in the original file's directory.
    4545             : 
    4546             : On MS-DOS filesystems without long names this variable is always
    4547             : ignored."
    4548             :   :group 'backup
    4549             :   :type '(repeat (cons (regexp :tag "Regexp matching filename")
    4550             :                        (directory :tag "Backup directory name"))))
    4551             : 
    4552             : (defun normal-backup-enable-predicate (name)
    4553             :   "Default `backup-enable-predicate' function.
    4554             : Checks for files in `temporary-file-directory',
    4555             : `small-temporary-file-directory', and \"/tmp\"."
    4556         148 :   (let ((temporary-file-directory temporary-file-directory)
    4557             :         caseless)
    4558             :     ;; On MS-Windows, file-truename will convert short 8+3 aliases to
    4559             :     ;; their long file-name equivalents, so compare-strings does TRT.
    4560         148 :     (if (memq system-type '(ms-dos windows-nt))
    4561           0 :         (setq temporary-file-directory (file-truename temporary-file-directory)
    4562           0 :               name (file-truename name)
    4563         148 :               caseless t))
    4564         148 :     (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
    4565         148 :                                           name 0 nil caseless)))
    4566             :                ;; Directory is under temporary-file-directory.
    4567         148 :                (and (not (eq comp t))
    4568         148 :                     (< comp (- (length temporary-file-directory)))))
    4569         148 :              (let ((comp (compare-strings "/tmp" 0 nil
    4570         148 :                                           name 0 nil)))
    4571             :                ;; Directory is under /tmp.
    4572         148 :                (and (not (eq comp t))
    4573         148 :                     (< comp (- (length "/tmp")))))
    4574         148 :              (if small-temporary-file-directory
    4575           0 :                  (let ((comp (compare-strings small-temporary-file-directory
    4576             :                                               0 nil
    4577           0 :                                               name 0 nil caseless)))
    4578             :                    ;; Directory is under small-temporary-file-directory.
    4579           0 :                    (and (not (eq comp t))
    4580         148 :                         (< comp (- (length small-temporary-file-directory))))))))))
    4581             : 
    4582             : (defun make-backup-file-name (file)
    4583             :   "Create the non-numeric backup file name for FILE.
    4584             : This calls the function that `make-backup-file-name-function' specifies,
    4585             : with a single argument FILE."
    4586           0 :   (funcall (or make-backup-file-name-function
    4587           0 :                #'make-backup-file-name--default-function)
    4588           0 :            file))
    4589             : 
    4590             : (defun make-backup-file-name--default-function (file)
    4591             :   "Default function for `make-backup-file-name'.
    4592             : Normally this just returns FILE's name with `~' appended.
    4593             : It searches for a match for FILE in `backup-directory-alist'.
    4594             : If the directory for the backup doesn't exist, it is created."
    4595           0 :   (if (and (eq system-type 'ms-dos)
    4596           0 :            (not (msdos-long-file-names)))
    4597           0 :       (let ((fn (file-name-nondirectory file)))
    4598           0 :         (concat (file-name-directory file)
    4599           0 :                 (or (and (string-match "\\`[^.]+\\'" fn)
    4600           0 :                          (concat (match-string 0 fn) ".~"))
    4601           0 :                     (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
    4602           0 :                          (concat (match-string 0 fn) "~")))))
    4603           0 :     (concat (make-backup-file-name-1 file) "~")))
    4604             : 
    4605             : (defun make-backup-file-name-1 (file)
    4606             :   "Subroutine of `make-backup-file-name--default-function'.
    4607             : The function `find-backup-file-name' also uses this."
    4608           0 :   (let ((alist backup-directory-alist)
    4609             :         elt backup-directory abs-backup-directory)
    4610           0 :     (while alist
    4611           0 :       (setq elt (pop alist))
    4612           0 :       (if (string-match (car elt) file)
    4613           0 :           (setq backup-directory (cdr elt)
    4614           0 :                 alist nil)))
    4615             :     ;; If backup-directory is relative, it should be relative to the
    4616             :     ;; file's directory.  By expanding explicitly here, we avoid
    4617             :     ;; depending on default-directory.
    4618           0 :     (if backup-directory
    4619           0 :         (setq abs-backup-directory
    4620           0 :               (expand-file-name backup-directory
    4621           0 :                                 (file-name-directory file))))
    4622           0 :     (if (and abs-backup-directory (not (file-exists-p abs-backup-directory)))
    4623           0 :         (condition-case nil
    4624           0 :             (make-directory abs-backup-directory 'parents)
    4625           0 :           (file-error (setq backup-directory nil
    4626           0 :                             abs-backup-directory nil))))
    4627           0 :     (if (null backup-directory)
    4628           0 :         file
    4629           0 :       (if (file-name-absolute-p backup-directory)
    4630           0 :           (progn
    4631           0 :             (when (memq system-type '(windows-nt ms-dos cygwin))
    4632             :               ;; Normalize DOSish file names: downcase the drive
    4633             :               ;; letter, if any, and replace the leading "x:" with
    4634             :               ;; "/drive_x".
    4635           0 :               (or (file-name-absolute-p file)
    4636           0 :                   (setq file (expand-file-name file))) ; make defaults explicit
    4637             :               ;; Replace any invalid file-name characters (for the
    4638             :               ;; case of backing up remote files).
    4639           0 :               (setq file (expand-file-name (convert-standard-filename file)))
    4640           0 :               (if (eq (aref file 1) ?:)
    4641           0 :                   (setq file (concat "/"
    4642             :                                      "drive_"
    4643           0 :                                      (char-to-string (downcase (aref file 0)))
    4644           0 :                                      (if (eq (aref file 2) ?/)
    4645             :                                          ""
    4646           0 :                                        "/")
    4647           0 :                                      (substring file 2)))))
    4648             :             ;; Make the name unique by substituting directory
    4649             :             ;; separators.  It may not really be worth bothering about
    4650             :             ;; doubling `!'s in the original name...
    4651           0 :             (expand-file-name
    4652           0 :              (subst-char-in-string
    4653             :               ?/ ?!
    4654           0 :               (replace-regexp-in-string "!" "!!" file))
    4655           0 :              backup-directory))
    4656           0 :         (expand-file-name (file-name-nondirectory file)
    4657           0 :                           (file-name-as-directory abs-backup-directory))))))
    4658             : 
    4659             : (defun backup-file-name-p (file)
    4660             :   "Return non-nil if FILE is a backup file name (numeric or not).
    4661             : This is a separate function so you can redefine it for customization.
    4662             : You may need to redefine `file-name-sans-versions' as well."
    4663         148 :     (string-match "~\\'" file))
    4664             : 
    4665             : (defvar backup-extract-version-start)
    4666             : 
    4667             : ;; This is used in various files.
    4668             : ;; The usage of backup-extract-version-start is not very clean,
    4669             : ;; but I can't see a good alternative, so as of now I am leaving it alone.
    4670             : (defun backup-extract-version (fn)
    4671             :   "Given the name of a numeric backup file, FN, return the backup number.
    4672             : Uses the free variable `backup-extract-version-start', whose value should be
    4673             : the index in the name where the version number begins."
    4674           0 :   (if (and (string-match "[0-9]+~/?$" fn backup-extract-version-start)
    4675           0 :            (= (match-beginning 0) backup-extract-version-start))
    4676           0 :       (string-to-number (substring fn backup-extract-version-start -1))
    4677           0 :       0))
    4678             : 
    4679             : (defun find-backup-file-name (fn)
    4680             :   "Find a file name for a backup file FN, and suggestions for deletions.
    4681             : Value is a list whose car is the name for the backup file
    4682             : and whose cdr is a list of old versions to consider deleting now.
    4683             : If the value is nil, don't make a backup.
    4684             : Uses `backup-directory-alist' in the same way as
    4685             : `make-backup-file-name--default-function' does."
    4686           0 :   (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
    4687             :     ;; Run a handler for this function so that ange-ftp can refuse to do it.
    4688           0 :     (if handler
    4689           0 :         (funcall handler 'find-backup-file-name fn)
    4690           0 :       (if (or (eq version-control 'never)
    4691             :               ;; We don't support numbered backups on plain MS-DOS
    4692             :               ;; when long file names are unavailable.
    4693           0 :               (and (eq system-type 'ms-dos)
    4694           0 :                    (not (msdos-long-file-names))))
    4695           0 :           (list (make-backup-file-name fn))
    4696           0 :         (let* ((basic-name (make-backup-file-name-1 fn))
    4697           0 :                (base-versions (concat (file-name-nondirectory basic-name)
    4698           0 :                                       ".~"))
    4699           0 :                (backup-extract-version-start (length base-versions))
    4700             :                (high-water-mark 0)
    4701             :                (number-to-delete 0)
    4702             :                possibilities deserve-versions-p versions)
    4703           0 :           (condition-case ()
    4704           0 :               (setq possibilities (file-name-all-completions
    4705           0 :                                    base-versions
    4706           0 :                                    (file-name-directory basic-name))
    4707           0 :                     versions (sort (mapcar #'backup-extract-version
    4708           0 :                                            possibilities)
    4709           0 :                                    #'<)
    4710           0 :                     high-water-mark (apply 'max 0 versions)
    4711           0 :                     deserve-versions-p (or version-control
    4712           0 :                                            (> high-water-mark 0))
    4713           0 :                     number-to-delete (- (length versions)
    4714           0 :                                         kept-old-versions
    4715           0 :                                         kept-new-versions
    4716           0 :                                         -1))
    4717           0 :             (file-error (setq possibilities nil)))
    4718           0 :           (if (not deserve-versions-p)
    4719           0 :               (list (make-backup-file-name fn))
    4720           0 :             (cons (format "%s.~%d~" basic-name (1+ high-water-mark))
    4721           0 :                   (if (and (> number-to-delete 0)
    4722             :                            ;; Delete nothing if there is overflow
    4723             :                            ;; in the number of versions to keep.
    4724           0 :                            (>= (+ kept-new-versions kept-old-versions -1) 0))
    4725           0 :                       (mapcar (lambda (n)
    4726           0 :                                 (format "%s.~%d~" basic-name n))
    4727           0 :                               (let ((v (nthcdr kept-old-versions versions)))
    4728           0 :                                 (rplacd (nthcdr (1- number-to-delete) v) ())
    4729           0 :                                 v))))))))))
    4730             : 
    4731             : (defun file-nlinks (filename)
    4732             :   "Return number of names file FILENAME has."
    4733           0 :   (car (cdr (file-attributes filename))))
    4734             : 
    4735             : ;; (defun file-relative-name (filename &optional directory)
    4736             : ;;   "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
    4737             : ;; This function returns a relative file name which is equivalent to FILENAME
    4738             : ;; when used with that default directory as the default.
    4739             : ;; If this is impossible (which can happen on MSDOS and Windows
    4740             : ;; when the file name and directory use different drive names)
    4741             : ;; then it returns FILENAME."
    4742             : ;;   (save-match-data
    4743             : ;;     (let ((fname (expand-file-name filename)))
    4744             : ;;       (setq directory (file-name-as-directory
    4745             : ;;                     (expand-file-name (or directory default-directory))))
    4746             : ;;       ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
    4747             : ;;       ;; drive names, they can't be relative, so return the absolute name.
    4748             : ;;       (if (and (or (eq system-type 'ms-dos)
    4749             : ;;                 (eq system-type 'cygwin)
    4750             : ;;                 (eq system-type 'windows-nt))
    4751             : ;;             (not (string-equal (substring fname  0 2)
    4752             : ;;                                (substring directory 0 2))))
    4753             : ;;        filename
    4754             : ;;      (let ((ancestor ".")
    4755             : ;;            (fname-dir (file-name-as-directory fname)))
    4756             : ;;        (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
    4757             : ;;                    (not (string-match (concat "^" (regexp-quote directory)) fname)))
    4758             : ;;          (setq directory (file-name-directory (substring directory 0 -1))
    4759             : ;;                ancestor (if (equal ancestor ".")
    4760             : ;;                             ".."
    4761             : ;;                           (concat "../" ancestor))))
    4762             : ;;        ;; Now ancestor is empty, or .., or ../.., etc.
    4763             : ;;        (if (string-match (concat "^" (regexp-quote directory)) fname)
    4764             : ;;            ;; We matched within FNAME's directory part.
    4765             : ;;            ;; Add the rest of FNAME onto ANCESTOR.
    4766             : ;;            (let ((rest (substring fname (match-end 0))))
    4767             : ;;              (if (and (equal ancestor ".")
    4768             : ;;                       (not (equal rest "")))
    4769             : ;;                  ;; But don't bother with ANCESTOR if it would give us `./'.
    4770             : ;;                  rest
    4771             : ;;                (concat (file-name-as-directory ancestor) rest)))
    4772             : ;;          ;; We matched FNAME's directory equivalent.
    4773             : ;;          ancestor))))))
    4774             : 
    4775             : (defun file-relative-name (filename &optional directory)
    4776             :   "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
    4777             : This function returns a relative file name which is equivalent to FILENAME
    4778             : when used with that default directory as the default.
    4779             : If FILENAME is a relative file name, it will be interpreted as existing in
    4780             : `default-directory'.
    4781             : If FILENAME and DIRECTORY lie on different machines or on different drives
    4782             : on a DOS/Windows machine, it returns FILENAME in expanded form."
    4783         418 :   (save-match-data
    4784         418 :     (setq directory
    4785         418 :           (file-name-as-directory (expand-file-name (or directory
    4786         418 :                                                         default-directory))))
    4787         418 :     (setq filename (expand-file-name filename))
    4788         418 :     (let ((fremote (file-remote-p filename))
    4789         418 :           (dremote (file-remote-p directory))
    4790         418 :           (fold-case (or (file-name-case-insensitive-p filename)
    4791         418 :                          read-file-name-completion-ignore-case)))
    4792         418 :       (if ;; Conditions for separate trees
    4793         418 :           (or
    4794             :            ;; Test for different filesystems on DOS/Windows
    4795         418 :            (and
    4796             :             ;; Should `cygwin' really be included here?  --stef
    4797         418 :             (memq system-type '(ms-dos cygwin windows-nt))
    4798           0 :             (or
    4799             :              ;; Test for different drive letters
    4800           0 :              (not (eq t (compare-strings filename 0 2 directory 0 2 fold-case)))
    4801             :              ;; Test for UNCs on different servers
    4802           0 :              (not (eq t (compare-strings
    4803           0 :                          (progn
    4804           0 :                            (if (string-match "\\`//\\([^:/]+\\)/" filename)
    4805           0 :                                (match-string 1 filename)
    4806             :                              ;; Windows file names cannot have ? in
    4807             :                              ;; them, so use that to detect when
    4808             :                              ;; neither FILENAME nor DIRECTORY is a
    4809             :                              ;; UNC.
    4810           0 :                              "?"))
    4811             :                          0 nil
    4812           0 :                          (progn
    4813           0 :                            (if (string-match "\\`//\\([^:/]+\\)/" directory)
    4814           0 :                                (match-string 1 directory)
    4815           0 :                              "?"))
    4816         418 :                          0 nil t)))))
    4817             :            ;; Test for different remote file system identification
    4818         418 :            (not (equal fremote dremote)))
    4819           6 :           filename
    4820         412 :         (let ((ancestor ".")
    4821         412 :               (filename-dir (file-name-as-directory filename)))
    4822         412 :           (while (not
    4823         412 :                   (or (string-prefix-p directory filename-dir fold-case)
    4824         412 :                       (string-prefix-p directory filename fold-case)))
    4825           0 :             (setq directory (file-name-directory (substring directory 0 -1))
    4826           0 :                   ancestor (if (equal ancestor ".")
    4827             :                                ".."
    4828         412 :                              (concat "../" ancestor))))
    4829             :           ;; Now ancestor is empty, or .., or ../.., etc.
    4830         412 :           (if (string-prefix-p directory filename fold-case)
    4831             :               ;; We matched within FILENAME's directory part.
    4832             :               ;; Add the rest of FILENAME onto ANCESTOR.
    4833         412 :               (let ((rest (substring filename (length directory))))
    4834         412 :                 (if (and (equal ancestor ".") (not (equal rest "")))
    4835             :                     ;; But don't bother with ANCESTOR if it would give us `./'.
    4836         412 :                     rest
    4837         412 :                   (concat (file-name-as-directory ancestor) rest)))
    4838             :             ;; We matched FILENAME's directory equivalent.
    4839         418 :             ancestor))))))
    4840             : 
    4841             : (defun save-buffer (&optional arg)
    4842             :   "Save current buffer in visited file if modified.
    4843             : Variations are described below.
    4844             : 
    4845             : By default, makes the previous version into a backup file
    4846             :  if previously requested or if this is the first save.
    4847             : Prefixed with one \\[universal-argument], marks this version
    4848             :  to become a backup when the next save is done.
    4849             : Prefixed with two \\[universal-argument]'s,
    4850             :  makes the previous version into a backup file.
    4851             : Prefixed with three \\[universal-argument]'s, marks this version
    4852             :  to become a backup when the next save is done,
    4853             :  and makes the previous version into a backup file.
    4854             : 
    4855             : With a numeric prefix argument of 0, never make the previous version
    4856             : into a backup file.
    4857             : 
    4858             : Note that the various variables that control backups, such
    4859             : as `version-control', `backup-enable-predicate', `vc-make-backup-files',
    4860             : and `backup-inhibited', to name just the more popular ones, still
    4861             : control whether a backup will actually be produced, even when you
    4862             : invoke this command prefixed with two or three \\[universal-argument]'s.
    4863             : 
    4864             : If a file's name is FOO, the names of its numbered backup versions are
    4865             :  FOO.~i~ for various integers i.  A non-numbered backup file is called FOO~.
    4866             : Numeric backups (rather than FOO~) will be made if value of
    4867             :  `version-control' is not the atom `never' and either there are already
    4868             :  numeric versions of the file being backed up, or `version-control' is
    4869             :  non-nil.
    4870             : We don't want excessive versions piling up, so there are variables
    4871             :  `kept-old-versions', which tells Emacs how many oldest versions to keep,
    4872             :  and `kept-new-versions', which tells how many newest versions to keep.
    4873             :  Defaults are 2 old versions and 2 new.
    4874             : `dired-kept-versions' controls dired's clean-directory (.) command.
    4875             : If `delete-old-versions' is nil, system will query user
    4876             :  before trimming versions.  Otherwise it does it silently.
    4877             : 
    4878             : If `vc-make-backup-files' is nil, which is the default,
    4879             :  no backup files are made for files managed by version control.
    4880             :  (This is because the version control system itself records previous versions.)
    4881             : 
    4882             : See the subroutine `basic-save-buffer' for more information."
    4883             :   (interactive "p")
    4884           0 :   (let ((modp (buffer-modified-p))
    4885           0 :         (make-backup-files (or (and make-backup-files (not (eq arg 0)))
    4886           0 :                                (memq arg '(16 64)))))
    4887           0 :     (and modp (memq arg '(16 64)) (setq buffer-backed-up nil))
    4888             :     ;; We used to display the message below only for files > 50KB, but
    4889             :     ;; then Rmail-mbox never displays it due to buffer swapping.  If
    4890             :     ;; the test is ever re-introduced, be sure to handle saving of
    4891             :     ;; Rmail files.
    4892           0 :     (if (and modp
    4893           0 :              (buffer-file-name)
    4894           0 :              (not noninteractive)
    4895           0 :              (not save-silently))
    4896           0 :         (message "Saving file %s..." (buffer-file-name)))
    4897           0 :     (basic-save-buffer (called-interactively-p 'any))
    4898           0 :     (and modp (memq arg '(4 64)) (setq buffer-backed-up nil))))
    4899             : 
    4900             : (defun delete-auto-save-file-if-necessary (&optional force)
    4901             :   "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
    4902             : Normally delete only if the file was written by this Emacs since
    4903             : the last real save, but optional arg FORCE non-nil means delete anyway."
    4904           0 :   (and buffer-auto-save-file-name delete-auto-save-files
    4905           0 :        (not (string= buffer-file-name buffer-auto-save-file-name))
    4906           0 :        (or force (recent-auto-save-p))
    4907           0 :        (progn
    4908           0 :          (condition-case ()
    4909           0 :              (delete-file buffer-auto-save-file-name)
    4910           0 :            (file-error nil))
    4911           0 :          (set-buffer-auto-saved))))
    4912             : 
    4913             : (defvar auto-save-hook nil
    4914             :   "Normal hook run just before auto-saving.")
    4915             : 
    4916             : (defcustom before-save-hook nil
    4917             :   "Normal hook that is run before a buffer is saved to its file.
    4918             : Only used by `save-buffer'."
    4919             :   :options '(copyright-update time-stamp)
    4920             :   :type 'hook
    4921             :   :group 'files)
    4922             : 
    4923             : (defcustom after-save-hook nil
    4924             :   "Normal hook that is run after a buffer is saved to its file.
    4925             : Only used by `save-buffer'."
    4926             :   :options '(executable-make-buffer-file-executable-if-script-p)
    4927             :   :type 'hook
    4928             :   :group 'files)
    4929             : 
    4930             : (defvar save-buffer-coding-system nil
    4931             :   "If non-nil, use this coding system for saving the buffer.
    4932             : More precisely, use this coding system in place of the
    4933             : value of `buffer-file-coding-system', when saving the buffer.
    4934             : Calling `write-region' for any purpose other than saving the buffer
    4935             : will still use `buffer-file-coding-system'; this variable has no effect
    4936             : in such cases.")
    4937             : 
    4938             : (make-variable-buffer-local 'save-buffer-coding-system)
    4939             : (put 'save-buffer-coding-system 'permanent-local t)
    4940             : 
    4941             : (defun basic-save-buffer (&optional called-interactively)
    4942             :   "Save the current buffer in its visited file, if it has been modified.
    4943             : The hooks `write-contents-functions' and `write-file-functions' get a chance
    4944             : to do the job of saving; if they do not, then the buffer is saved in
    4945             : the visited file in the usual way.
    4946             : Before and after saving the buffer, this function runs
    4947             : `before-save-hook' and `after-save-hook', respectively."
    4948             :   (interactive '(called-interactively))
    4949           0 :   (save-current-buffer
    4950             :     ;; In an indirect buffer, save its base buffer instead.
    4951           0 :     (if (buffer-base-buffer)
    4952           0 :         (set-buffer (buffer-base-buffer)))
    4953           0 :     (if (or (buffer-modified-p)
    4954             :             ;; handle the case when no modification has been made but
    4955             :             ;; the file disappeared since visited
    4956           0 :             (and buffer-file-name
    4957           0 :                  (not (file-exists-p buffer-file-name))))
    4958           0 :         (let ((recent-save (recent-auto-save-p))
    4959             :               setmodes)
    4960             :           ;; If buffer has no file name, ask user for one.
    4961           0 :           (or buffer-file-name
    4962           0 :               (let ((filename
    4963           0 :                      (expand-file-name
    4964           0 :                       (read-file-name "File to save in: "
    4965           0 :                                       nil (expand-file-name (buffer-name))))))
    4966           0 :                 (if (file-exists-p filename)
    4967           0 :                     (if (file-directory-p filename)
    4968             :                         ;; Signal an error if the user specified the name of an
    4969             :                         ;; existing directory.
    4970           0 :                         (error "%s is a directory" filename)
    4971           0 :                       (unless (y-or-n-p (format-message
    4972             :                                          "File `%s' exists; overwrite? "
    4973           0 :                                          filename))
    4974           0 :                         (error "Canceled"))))
    4975           0 :                 (set-visited-file-name filename)))
    4976           0 :           (or (verify-visited-file-modtime (current-buffer))
    4977           0 :               (not (file-exists-p buffer-file-name))
    4978           0 :               (yes-or-no-p
    4979           0 :                (format
    4980             :                 "%s has changed since visited or saved.  Save anyway? "
    4981           0 :                 (file-name-nondirectory buffer-file-name)))
    4982           0 :               (user-error "Save not confirmed"))
    4983           0 :           (save-restriction
    4984           0 :             (widen)
    4985           0 :             (save-excursion
    4986           0 :               (and (> (point-max) (point-min))
    4987           0 :                    (not find-file-literally)
    4988           0 :                    (/= (char-after (1- (point-max))) ?\n)
    4989           0 :                    (not (and (eq selective-display t)
    4990           0 :                              (= (char-after (1- (point-max))) ?\r)))
    4991           0 :                    (or (eq require-final-newline t)
    4992           0 :                        (eq require-final-newline 'visit-save)
    4993           0 :                        (and require-final-newline
    4994           0 :                             (y-or-n-p
    4995           0 :                              (format "Buffer %s does not end in newline.  Add one? "
    4996           0 :                                      (buffer-name)))))
    4997           0 :                    (save-excursion
    4998           0 :                      (goto-char (point-max))
    4999           0 :                      (insert ?\n))))
    5000             :             ;; Support VC version backups.
    5001           0 :             (vc-before-save)
    5002             :             ;; Don't let errors prevent saving the buffer.
    5003           0 :             (with-demoted-errors (run-hooks 'before-save-hook))
    5004           0 :             (or (run-hook-with-args-until-success 'write-contents-functions)
    5005           0 :                 (run-hook-with-args-until-success 'local-write-file-hooks)
    5006           0 :                 (run-hook-with-args-until-success 'write-file-functions)
    5007             :                 ;; If a hook returned t, file is already "written".
    5008             :                 ;; Otherwise, write it the usual way now.
    5009           0 :                 (let ((dir (file-name-directory
    5010           0 :                             (expand-file-name buffer-file-name))))
    5011           0 :                   (unless (file-exists-p dir)
    5012           0 :                     (if (y-or-n-p
    5013           0 :                          (format-message
    5014           0 :                           "Directory `%s' does not exist; create? " dir))
    5015           0 :                         (make-directory dir t)
    5016           0 :                       (error "Canceled")))
    5017           0 :                   (setq setmodes (basic-save-buffer-1))))
    5018             :             ;; Now we have saved the current buffer.  Let's make sure
    5019             :             ;; that buffer-file-coding-system is fixed to what
    5020             :             ;; actually used for saving by binding it locally.
    5021           0 :             (if save-buffer-coding-system
    5022           0 :                 (setq save-buffer-coding-system last-coding-system-used)
    5023           0 :               (setq buffer-file-coding-system last-coding-system-used))
    5024           0 :             (setq buffer-file-number
    5025           0 :                   (nthcdr 10 (file-attributes buffer-file-name)))
    5026           0 :             (if setmodes
    5027           0 :                 (condition-case ()
    5028           0 :                     (progn
    5029           0 :                       (unless
    5030           0 :                           (with-demoted-errors
    5031           0 :                             (set-file-modes buffer-file-name (car setmodes)))
    5032           0 :                         (set-file-extended-attributes buffer-file-name
    5033           0 :                                                       (nth 1 setmodes))))
    5034           0 :                   (error nil))))
    5035             :           ;; If the auto-save file was recent before this command,
    5036             :           ;; delete it now.
    5037           0 :           (delete-auto-save-file-if-necessary recent-save)
    5038             :           ;; Support VC `implicit' locking.
    5039           0 :           (vc-after-save)
    5040           0 :           (run-hooks 'after-save-hook))
    5041           0 :       (or noninteractive
    5042           0 :           (not called-interactively)
    5043           0 :           (files--message "(No changes need to be saved)")))))
    5044             : 
    5045             : ;; This does the "real job" of writing a buffer into its visited file
    5046             : ;; and making a backup file.  This is what is normally done
    5047             : ;; but inhibited if one of write-file-functions returns non-nil.
    5048             : ;; It returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
    5049             : ;; backup-buffer.
    5050             : (defun basic-save-buffer-1 ()
    5051           0 :   (prog1
    5052           0 :       (if save-buffer-coding-system
    5053           0 :           (let ((coding-system-for-write save-buffer-coding-system))
    5054           0 :             (basic-save-buffer-2))
    5055           0 :         (basic-save-buffer-2))
    5056           0 :     (if buffer-file-coding-system-explicit
    5057           0 :         (setcar buffer-file-coding-system-explicit last-coding-system-used))))
    5058             : 
    5059             : ;; This returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
    5060             : ;; backup-buffer.
    5061             : (defun basic-save-buffer-2 ()
    5062           0 :   (let (tempsetmodes setmodes)
    5063           0 :     (if (not (file-writable-p buffer-file-name))
    5064           0 :         (let ((dir (file-name-directory buffer-file-name)))
    5065           0 :           (if (not (file-directory-p dir))
    5066           0 :               (if (file-exists-p dir)
    5067           0 :                   (error "%s is not a directory" dir)
    5068           0 :                 (error "%s: no such directory" dir))
    5069           0 :             (if (not (file-exists-p buffer-file-name))
    5070           0 :                 (error "Directory %s write-protected" dir)
    5071           0 :               (if (yes-or-no-p
    5072           0 :                    (format
    5073             :                     "File %s is write-protected; try to save anyway? "
    5074           0 :                     (file-name-nondirectory
    5075           0 :                      buffer-file-name)))
    5076           0 :                   (setq tempsetmodes t)
    5077           0 :                 (error "Attempt to save to a file which you aren't allowed to write"))))))
    5078           0 :     (or buffer-backed-up
    5079           0 :         (setq setmodes (backup-buffer)))
    5080           0 :     (let* ((dir (file-name-directory buffer-file-name))
    5081           0 :            (dir-writable (file-writable-p dir)))
    5082           0 :       (if (or (and file-precious-flag dir-writable)
    5083           0 :               (and break-hardlink-on-save
    5084           0 :                    (file-exists-p buffer-file-name)
    5085           0 :                    (> (file-nlinks buffer-file-name) 1)
    5086           0 :                    (or dir-writable
    5087           0 :                        (error (concat "Directory %s write-protected; "
    5088           0 :                                       "cannot break hardlink when saving")
    5089           0 :                               dir))))
    5090             :           ;; Write temp name, then rename it.
    5091             :           ;; This requires write access to the containing dir,
    5092             :           ;; which is why we don't try it if we don't have that access.
    5093           0 :           (let ((realname buffer-file-name)
    5094             :                 tempname
    5095           0 :                 (old-modtime (visited-file-modtime)))
    5096             :             ;; Create temp files with strict access rights.  It's easy to
    5097             :             ;; loosen them later, whereas it's impossible to close the
    5098             :             ;; time-window of loose permissions otherwise.
    5099           0 :             (condition-case err
    5100           0 :                 (progn
    5101           0 :                   (clear-visited-file-modtime)
    5102             :                   ;; Call write-region in the appropriate way
    5103             :                   ;; for saving the buffer.
    5104           0 :                   (setq tempname
    5105           0 :                         (make-temp-file
    5106           0 :                          (expand-file-name "tmp" dir)))
    5107             :                   ;; Pass in nil&nil rather than point-min&max
    5108             :                   ;; cause we're saving the whole buffer.
    5109             :                   ;; write-region-annotate-functions may use it.
    5110           0 :                   (write-region nil nil tempname nil realname
    5111           0 :                                 buffer-file-truename)
    5112           0 :                   (when save-silently (message nil)))
    5113             :               ;; If we failed, restore the buffer's modtime.
    5114           0 :               (error (set-visited-file-modtime old-modtime)
    5115           0 :                      (signal (car err) (cdr err))))
    5116             :             ;; Since we have created an entirely new file,
    5117             :             ;; make sure it gets the right permission bits set.
    5118           0 :             (setq setmodes (or setmodes
    5119           0 :                                (list (or (file-modes buffer-file-name)
    5120           0 :                                          (logand ?\666 (default-file-modes)))
    5121           0 :                                      (file-extended-attributes buffer-file-name)
    5122           0 :                                      buffer-file-name)))
    5123             :             ;; We succeeded in writing the temp file,
    5124             :             ;; so rename it.
    5125           0 :             (rename-file tempname buffer-file-name t))
    5126             :         ;; If file not writable, see if we can make it writable
    5127             :         ;; temporarily while we write it.
    5128             :         ;; But no need to do so if we have just backed it up
    5129             :         ;; (setmodes is set) because that says we're superseding.
    5130           0 :         (cond ((and tempsetmodes (not setmodes))
    5131             :                ;; Change the mode back, after writing.
    5132           0 :                (setq setmodes (list (file-modes buffer-file-name)
    5133           0 :                                     (file-extended-attributes buffer-file-name)
    5134           0 :                                     buffer-file-name))
    5135             :                ;; If set-file-extended-attributes fails, fall back on
    5136             :                ;; set-file-modes.
    5137           0 :                (unless
    5138           0 :                    (with-demoted-errors
    5139           0 :                      (set-file-extended-attributes buffer-file-name
    5140           0 :                                                    (nth 1 setmodes)))
    5141           0 :                  (set-file-modes buffer-file-name
    5142           0 :                                  (logior (car setmodes) 128))))))
    5143           0 :         (let (success)
    5144           0 :           (unwind-protect
    5145           0 :               (progn
    5146             :                 ;; Pass in nil&nil rather than point-min&max to indicate
    5147             :                 ;; we're saving the buffer rather than just a region.
    5148             :                 ;; write-region-annotate-functions may make us of it.
    5149           0 :                 (write-region nil nil
    5150           0 :                               buffer-file-name nil t buffer-file-truename)
    5151           0 :                 (when save-silently (message nil))
    5152           0 :                 (setq success t))
    5153             :             ;; If we get an error writing the new file, and we made
    5154             :             ;; the backup by renaming, undo the backing-up.
    5155           0 :             (and setmodes (not success)
    5156           0 :                  (progn
    5157           0 :                    (rename-file (nth 2 setmodes) buffer-file-name t)
    5158           0 :                    (setq buffer-backed-up nil))))))
    5159           0 :     setmodes))
    5160             : 
    5161             : (declare-function diff-no-select "diff"
    5162             :                   (old new &optional switches no-async buf))
    5163             : 
    5164             : (defvar save-some-buffers-action-alist
    5165             :   `((?\C-r
    5166             :      ,(lambda (buf)
    5167             :         (if (not enable-recursive-minibuffers)
    5168             :             (progn (display-buffer buf)
    5169             :                    (setq other-window-scroll-buffer buf))
    5170             :           (view-buffer buf (lambda (_) (exit-recursive-edit)))
    5171             :           (recursive-edit))
    5172             :         ;; Return nil to ask about BUF again.
    5173             :         nil)
    5174             :      ,(purecopy "view this buffer"))
    5175             :     (?d ,(lambda (buf)
    5176             :            (if (null (buffer-file-name buf))
    5177             :                (message "Not applicable: no file")
    5178             :              (require 'diff)            ;for diff-no-select.
    5179             :              (let ((diffbuf (diff-no-select (buffer-file-name buf) buf
    5180             :                                             nil 'noasync)))
    5181             :                (if (not enable-recursive-minibuffers)
    5182             :                    (progn (display-buffer diffbuf)
    5183             :                           (setq other-window-scroll-buffer diffbuf))
    5184             :                  (view-buffer diffbuf (lambda (_) (exit-recursive-edit)))
    5185             :                  (recursive-edit))))
    5186             :            ;; Return nil to ask about BUF again.
    5187             :            nil)
    5188             :         ,(purecopy "view changes in this buffer")))
    5189             :   "ACTION-ALIST argument used in call to `map-y-or-n-p'.")
    5190             : (put 'save-some-buffers-action-alist 'risky-local-variable t)
    5191             : 
    5192             : (defvar buffer-save-without-query nil
    5193             :   "Non-nil means `save-some-buffers' should save this buffer without asking.")
    5194             : (make-variable-buffer-local 'buffer-save-without-query)
    5195             : 
    5196             : (defcustom save-some-buffers-default-predicate nil
    5197             :   "Default predicate for `save-some-buffers'.
    5198             : This allows you to stop `save-some-buffers' from asking
    5199             : about certain files that you'd usually rather not save."
    5200             :   :group 'auto-save
    5201             :   :type 'function
    5202             :   :version "26.1")
    5203             : 
    5204             : (defun save-some-buffers (&optional arg pred)
    5205             :   "Save some modified file-visiting buffers.  Asks user about each one.
    5206             : You can answer `y' to save, `n' not to save, `C-r' to look at the
    5207             : buffer in question with `view-buffer' before deciding or `d' to
    5208             : view the differences using `diff-buffer-with-file'.
    5209             : 
    5210             : This command first saves any buffers where `buffer-save-without-query' is
    5211             : non-nil, without asking.
    5212             : 
    5213             : Optional argument (the prefix) non-nil means save all with no questions.
    5214             : Optional second argument PRED determines which buffers are considered:
    5215             : If PRED is nil, all the file-visiting buffers are considered.
    5216             : If PRED is t, then certain non-file buffers will also be considered.
    5217             : If PRED is a zero-argument function, it indicates for each buffer whether
    5218             : to consider it or not when called with that buffer current.
    5219             : PRED defaults to the value of `save-some-buffers-default-predicate'.
    5220             : 
    5221             : See `save-some-buffers-action-alist' if you want to
    5222             : change the additional actions you can take on files."
    5223             :   (interactive "P")
    5224           0 :   (unless pred
    5225           0 :     (setq pred save-some-buffers-default-predicate))
    5226           0 :   (save-window-excursion
    5227           0 :     (let* (queried autosaved-buffers
    5228             :            files-done abbrevs-done)
    5229           0 :       (dolist (buffer (buffer-list))
    5230             :         ;; First save any buffers that we're supposed to save unconditionally.
    5231             :         ;; That way the following code won't ask about them.
    5232           0 :         (with-current-buffer buffer
    5233           0 :           (when (and buffer-save-without-query (buffer-modified-p))
    5234           0 :             (push (buffer-name) autosaved-buffers)
    5235           0 :             (save-buffer))))
    5236             :       ;; Ask about those buffers that merit it,
    5237             :       ;; and record the number thus saved.
    5238           0 :       (setq files-done
    5239           0 :             (map-y-or-n-p
    5240             :              (lambda (buffer)
    5241             :                ;; Note that killing some buffers may kill others via
    5242             :                ;; hooks (e.g. Rmail and its viewing buffer).
    5243           0 :                (and (buffer-live-p buffer)
    5244           0 :                     (buffer-modified-p buffer)
    5245           0 :                     (not (buffer-base-buffer buffer))
    5246           0 :                     (or
    5247           0 :                      (buffer-file-name buffer)
    5248           0 :                      (and pred
    5249           0 :                           (progn
    5250           0 :                             (set-buffer buffer)
    5251           0 :                             (and buffer-offer-save (> (buffer-size) 0)))))
    5252           0 :                     (or (not (functionp pred))
    5253           0 :                         (with-current-buffer buffer (funcall pred)))
    5254           0 :                     (if arg
    5255             :                         t
    5256           0 :                       (setq queried t)
    5257           0 :                       (if (buffer-file-name buffer)
    5258           0 :                           (format "Save file %s? "
    5259           0 :                                   (buffer-file-name buffer))
    5260           0 :                         (format "Save buffer %s? "
    5261           0 :                                 (buffer-name buffer))))))
    5262             :              (lambda (buffer)
    5263           0 :                (with-current-buffer buffer
    5264           0 :                  (save-buffer)))
    5265           0 :              (buffer-list)
    5266             :              '("buffer" "buffers" "save")
    5267           0 :              save-some-buffers-action-alist))
    5268             :       ;; Maybe to save abbrevs, and record whether
    5269             :       ;; we either saved them or asked to.
    5270           0 :       (and save-abbrevs abbrevs-changed
    5271           0 :            (progn
    5272           0 :              (if (or arg
    5273           0 :                      (eq save-abbrevs 'silently)
    5274           0 :                      (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
    5275           0 :                  (write-abbrev-file nil))
    5276             :              ;; Don't keep bothering user if he says no.
    5277           0 :              (setq abbrevs-changed nil)
    5278           0 :              (setq abbrevs-done t)))
    5279           0 :       (or queried (> files-done 0) abbrevs-done
    5280           0 :           (cond
    5281           0 :            ((null autosaved-buffers)
    5282           0 :             (when (called-interactively-p 'any)
    5283           0 :               (files--message "(No files need saving)")))
    5284           0 :            ((= (length autosaved-buffers) 1)
    5285           0 :             (files--message "(Saved %s)" (car autosaved-buffers)))
    5286             :            (t
    5287           0 :             (files--message "(Saved %d files: %s)"
    5288           0 :                             (length autosaved-buffers)
    5289           0 :                             (mapconcat 'identity autosaved-buffers ", "))))))))
    5290             : 
    5291             : (defun clear-visited-file-modtime ()
    5292             :   "Clear out records of last mod time of visited file.
    5293             : Next attempt to save will not complain of a discrepancy."
    5294          27 :   (set-visited-file-modtime 0))
    5295             : 
    5296             : (defun not-modified (&optional arg)
    5297             :   "Mark current buffer as unmodified, not needing to be saved.
    5298             : With prefix ARG, mark buffer as modified, so \\[save-buffer] will save.
    5299             : 
    5300             : It is not a good idea to use this function in Lisp programs, because it
    5301             : prints a message in the minibuffer.  Instead, use `set-buffer-modified-p'."
    5302             :   (declare (interactive-only set-buffer-modified-p))
    5303             :   (interactive "P")
    5304           0 :   (files--message (if arg "Modification-flag set"
    5305           0 :                     "Modification-flag cleared"))
    5306           0 :   (set-buffer-modified-p arg))
    5307             : 
    5308             : (defun toggle-read-only (&optional arg interactive)
    5309             :   "Change whether this buffer is read-only."
    5310             :   (declare (obsolete read-only-mode "24.3"))
    5311           0 :   (interactive (list current-prefix-arg t))
    5312           0 :   (if interactive
    5313           0 :       (call-interactively 'read-only-mode)
    5314           0 :     (read-only-mode (or arg 'toggle))))
    5315             : 
    5316             : (defun insert-file (filename)
    5317             :   "Insert contents of file FILENAME into buffer after point.
    5318             : Set mark after the inserted text.
    5319             : 
    5320             : This function is meant for the user to run interactively.
    5321             : Don't call it from programs!  Use `insert-file-contents' instead.
    5322             : \(Its calling sequence is different; see its documentation)."
    5323             :   (declare (interactive-only insert-file-contents))
    5324             :   (interactive "*fInsert file: ")
    5325           0 :   (insert-file-1 filename #'insert-file-contents))
    5326             : 
    5327             : (defun append-to-file (start end filename)
    5328             :   "Append the contents of the region to the end of file FILENAME.
    5329             : When called from a function, expects three arguments,
    5330             : START, END and FILENAME.  START and END are normally buffer positions
    5331             : specifying the part of the buffer to write.
    5332             : If START is nil, that means to use the entire buffer contents.
    5333             : If START is a string, then output that string to the file
    5334             : instead of any buffer contents; END is ignored.
    5335             : 
    5336             : This does character code conversion and applies annotations
    5337             : like `write-region' does."
    5338             :   (interactive "r\nFAppend to file: ")
    5339           0 :   (prog1 (write-region start end filename t)
    5340           0 :     (when save-silently (message nil))))
    5341             : 
    5342             : (defun file-newest-backup (filename)
    5343             :   "Return most recent backup file for FILENAME or nil if no backups exist."
    5344             :   ;; `make-backup-file-name' will get us the right directory for
    5345             :   ;; ordinary or numeric backups.  It might create a directory for
    5346             :   ;; backups as a side-effect, according to `backup-directory-alist'.
    5347           0 :   (let* ((filename (file-name-sans-versions
    5348           0 :                     (make-backup-file-name (expand-file-name filename))))
    5349           0 :          (file (file-name-nondirectory filename))
    5350           0 :          (dir  (file-name-directory    filename))
    5351           0 :          (comp (file-name-all-completions file dir))
    5352             :          (newest nil)
    5353             :          tem)
    5354           0 :     (while comp
    5355           0 :       (setq tem (pop comp))
    5356           0 :       (cond ((and (backup-file-name-p tem)
    5357           0 :                   (string= (file-name-sans-versions tem) file))
    5358           0 :              (setq tem (concat dir tem))
    5359           0 :              (if (or (null newest)
    5360           0 :                      (file-newer-than-file-p tem newest))
    5361           0 :                  (setq newest tem)))))
    5362           0 :     newest))
    5363             : 
    5364             : (defun rename-uniquely ()
    5365             :   "Rename current buffer to a similar name not already taken.
    5366             : This function is useful for creating multiple shell process buffers
    5367             : or multiple mail buffers, etc.
    5368             : 
    5369             : Note that some commands, in particular those based on `compilation-mode'
    5370             : \(`compile', `grep', etc.) will reuse the current buffer if it has the
    5371             : appropriate mode even if it has been renamed.  So as well as renaming
    5372             : the buffer, you also need to switch buffers before running another
    5373             : instance of such commands."
    5374             :   (interactive)
    5375           0 :   (save-match-data
    5376           0 :     (let ((base-name (buffer-name)))
    5377           0 :       (and (string-match "<[0-9]+>\\'" base-name)
    5378           0 :            (not (and buffer-file-name
    5379           0 :                      (string= base-name
    5380           0 :                               (file-name-nondirectory buffer-file-name))))
    5381             :            ;; If the existing buffer name has a <NNN>,
    5382             :            ;; which isn't part of the file name (if any),
    5383             :            ;; then get rid of that.
    5384           0 :            (setq base-name (substring base-name 0 (match-beginning 0))))
    5385           0 :       (rename-buffer (generate-new-buffer-name base-name))
    5386           0 :       (force-mode-line-update))))
    5387             : 
    5388             : (defun make-directory (dir &optional parents)
    5389             :   "Create the directory DIR and optionally any nonexistent parent dirs.
    5390             : If DIR already exists as a directory, signal an error, unless
    5391             : PARENTS is non-nil.
    5392             : 
    5393             : Interactively, the default choice of directory to create is the
    5394             : current buffer's default directory.  That is useful when you have
    5395             : visited a file in a nonexistent directory.
    5396             : 
    5397             : Noninteractively, the second (optional) argument PARENTS, if
    5398             : non-nil, says whether to create parent directories that don't
    5399             : exist.  Interactively, this happens by default.
    5400             : 
    5401             : If creating the directory or directories fail, an error will be
    5402             : raised."
    5403             :   (interactive
    5404           0 :    (list (read-file-name "Make directory: " default-directory default-directory
    5405           0 :                          nil nil)
    5406           0 :          t))
    5407             :   ;; If default-directory is a remote directory,
    5408             :   ;; make sure we find its make-directory handler.
    5409         142 :   (setq dir (expand-file-name dir))
    5410         142 :   (let ((handler (find-file-name-handler dir 'make-directory)))
    5411         142 :     (if handler
    5412         132 :         (funcall handler 'make-directory dir parents)
    5413          10 :       (if (not parents)
    5414          10 :           (make-directory-internal dir)
    5415           0 :         (let ((dir (directory-file-name (expand-file-name dir)))
    5416             :               create-list)
    5417           0 :           (while (and (not (file-exists-p dir))
    5418             :                       ;; If directory is its own parent, then we can't
    5419             :                       ;; keep looping forever
    5420           0 :                       (not (equal dir
    5421           0 :                                   (directory-file-name
    5422           0 :                                    (file-name-directory dir)))))
    5423           0 :             (setq create-list (cons dir create-list)
    5424           0 :                   dir (directory-file-name (file-name-directory dir))))
    5425           0 :           (while create-list
    5426           0 :             (make-directory-internal (car create-list))
    5427         140 :             (setq create-list (cdr create-list))))))))
    5428             : 
    5429             : (defconst directory-files-no-dot-files-regexp
    5430             :   "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
    5431             :   "Regexp matching any file name except \".\" and \"..\".")
    5432             : 
    5433             : (defun files--force (no-such fn &rest args)
    5434             :   "Use NO-SUCH to affect behavior of function FN applied to list ARGS.
    5435             : This acts like (apply FN ARGS) except it returns NO-SUCH if it is
    5436             : non-nil and if FN fails due to a missing file or directory."
    5437         102 :   (condition-case err
    5438         102 :       (apply fn args)
    5439         102 :     (file-missing (or no-such (signal (car err) (cdr err))))))
    5440             : 
    5441             : (defun delete-directory (directory &optional recursive trash)
    5442             :   "Delete the directory named DIRECTORY.  Does not follow symlinks.
    5443             : If RECURSIVE is non-nil, delete files in DIRECTORY as well, with
    5444             : no error if something else is simultaneously deleting them.
    5445             : TRASH non-nil means to trash the directory instead, provided
    5446             : `delete-by-moving-to-trash' is non-nil.
    5447             : 
    5448             : When called interactively, TRASH is nil if and only if a prefix
    5449             : argument is given, and a further prompt asks the user for
    5450             : RECURSIVE if DIRECTORY is nonempty."
    5451             :   (interactive
    5452           0 :    (let* ((trashing (and delete-by-moving-to-trash
    5453           0 :                          (null current-prefix-arg)))
    5454           0 :           (dir (expand-file-name
    5455           0 :                 (read-directory-name
    5456           0 :                  (if trashing
    5457             :                      "Move directory to trash: "
    5458           0 :                    "Delete directory: ")
    5459           0 :                  default-directory default-directory nil nil))))
    5460           0 :      (list dir
    5461           0 :            (if (directory-files dir nil directory-files-no-dot-files-regexp)
    5462           0 :                (y-or-n-p
    5463           0 :                 (format-message "Directory `%s' is not empty, really %s? "
    5464           0 :                                 dir (if trashing "trash" "delete")))
    5465           0 :              nil)
    5466           0 :            (null current-prefix-arg))))
    5467             :   ;; If default-directory is a remote directory, make sure we find its
    5468             :   ;; delete-directory handler.
    5469         134 :   (setq directory (directory-file-name (expand-file-name directory)))
    5470         134 :   (let ((handler (find-file-name-handler directory 'delete-directory)))
    5471         134 :     (cond
    5472         134 :      (handler
    5473         124 :       (funcall handler 'delete-directory directory recursive trash))
    5474          10 :      ((and delete-by-moving-to-trash trash)
    5475             :       ;; Only move non-empty dir to trash if recursive deletion was
    5476             :       ;; requested.  This mimics the non-`delete-by-moving-to-trash'
    5477             :       ;; case, where the operation fails in delete-directory-internal.
    5478             :       ;; As `move-file-to-trash' trashes directories (empty or
    5479             :       ;; otherwise) as a unit, we do not need to recurse here.
    5480           0 :       (if (and (not recursive)
    5481             :                ;; Check if directory is empty apart from "." and "..".
    5482           0 :                (directory-files
    5483           0 :                 directory 'full directory-files-no-dot-files-regexp))
    5484           0 :           (error "Directory is not empty, not moving to trash")
    5485           0 :         (move-file-to-trash directory)))
    5486             :      ;; Otherwise, call ourselves recursively if needed.
    5487             :      (t
    5488          10 :       (when (or (not recursive) (file-symlink-p directory)
    5489          10 :                 (let* ((files
    5490          10 :                         (files--force t #'directory-files directory 'full
    5491          10 :                                       directory-files-no-dot-files-regexp))
    5492          10 :                        (directory-exists (listp files)))
    5493          10 :                   (when directory-exists
    5494          10 :                     (mapc (lambda (file)
    5495             :                             ;; This test is equivalent to but more efficient
    5496             :                             ;; than (and (file-directory-p fn)
    5497             :                             ;;           (not (file-symlink-p fn))).
    5498          82 :                             (if (eq t (car (file-attributes file)))
    5499           0 :                                 (delete-directory file recursive)
    5500          82 :                               (files--force t #'delete-file file)))
    5501          10 :                           files))
    5502          10 :                   directory-exists))
    5503         132 :         (files--force recursive #'delete-directory-internal directory))))))
    5504             : 
    5505             : (defun file-equal-p (file1 file2)
    5506             :   "Return non-nil if files FILE1 and FILE2 name the same file.
    5507             : If FILE1 or FILE2 does not exist, the return value is unspecified."
    5508           4 :   (let ((handler (or (find-file-name-handler file1 'file-equal-p)
    5509           4 :                      (find-file-name-handler file2 'file-equal-p))))
    5510           4 :     (if handler
    5511           2 :         (funcall handler 'file-equal-p file1 file2)
    5512           2 :       (let (f1-attr f2-attr)
    5513           2 :         (and (setq f1-attr (file-attributes (file-truename file1)))
    5514           2 :              (setq f2-attr (file-attributes (file-truename file2)))
    5515           4 :              (equal f1-attr f2-attr))))))
    5516             : 
    5517             : (defun file-in-directory-p (file dir)
    5518             :   "Return non-nil if FILE is in DIR or a subdirectory of DIR.
    5519             : A directory is considered to be \"in\" itself.
    5520             : Return nil if DIR is not an existing directory."
    5521          32 :   (let ((handler (or (find-file-name-handler file 'file-in-directory-p)
    5522          32 :                      (find-file-name-handler dir  'file-in-directory-p))))
    5523          32 :     (if handler
    5524          16 :         (funcall handler 'file-in-directory-p file dir)
    5525          16 :       (when (file-directory-p dir) ; DIR must exist.
    5526          16 :         (setq file (file-truename file)
    5527          16 :               dir  (file-truename dir))
    5528          16 :         (let ((ls1 (split-string file "/" t))
    5529          16 :               (ls2 (split-string dir  "/" t))
    5530             :               (root
    5531          16 :                (cond
    5532             :                 ;; A UNC on Windows systems, or a "super-root" on Apollo.
    5533          16 :                 ((string-match "\\`//" file) "//")
    5534          16 :                 ((string-match "\\`/" file) "/")
    5535          16 :                 (t "")))
    5536             :               (mismatch nil))
    5537         104 :           (while (and ls1 ls2 (not mismatch))
    5538          88 :             (if (string-equal (car ls1) (car ls2))
    5539          72 :                 (setq root (concat root (car ls1) "/"))
    5540          88 :               (setq mismatch t))
    5541          88 :             (setq ls1 (cdr ls1)
    5542          88 :                   ls2 (cdr ls2)))
    5543          16 :           (unless mismatch
    5544          32 :             (file-equal-p root dir)))))))
    5545             : 
    5546             : (defun copy-directory (directory newname &optional keep-time parents copy-contents)
    5547             :   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
    5548             : This function always sets the file modes of the output files to match
    5549             : the corresponding input file.
    5550             : 
    5551             : The third arg KEEP-TIME non-nil means give the output files the same
    5552             : last-modified time as the old ones.  (This works on only some systems.)
    5553             : 
    5554             : A prefix arg makes KEEP-TIME non-nil.
    5555             : 
    5556             : Noninteractively, the last argument PARENTS says whether to
    5557             : create parent directories if they don't exist.  Interactively,
    5558             : this happens by default.
    5559             : 
    5560             : If NEWNAME names an existing directory, copy DIRECTORY as a
    5561             : subdirectory there.  However, if called from Lisp with a non-nil
    5562             : optional argument COPY-CONTENTS, copy the contents of DIRECTORY
    5563             : directly into NEWNAME instead."
    5564             :   (interactive
    5565           0 :    (let ((dir (read-directory-name
    5566           0 :                "Copy directory: " default-directory default-directory t nil)))
    5567           0 :      (list dir
    5568           0 :            (read-directory-name
    5569           0 :             (format "Copy directory %s to: " dir)
    5570           0 :             default-directory default-directory nil nil)
    5571           0 :            current-prefix-arg t nil)))
    5572          16 :   (when (file-in-directory-p newname directory)
    5573           0 :     (error "Cannot copy `%s' into its subdirectory `%s'"
    5574          16 :            directory newname))
    5575             :   ;; If default-directory is a remote directory, make sure we find its
    5576             :   ;; copy-directory handler.
    5577          16 :   (let ((handler (or (find-file-name-handler directory 'copy-directory)
    5578          16 :                      (find-file-name-handler newname 'copy-directory))))
    5579          16 :     (if handler
    5580           8 :         (funcall handler 'copy-directory directory
    5581           8 :                  newname keep-time parents copy-contents)
    5582             : 
    5583             :       ;; Compute target name.
    5584           8 :       (setq directory (directory-file-name (expand-file-name directory))
    5585           8 :             newname   (directory-file-name (expand-file-name newname)))
    5586             : 
    5587           8 :       (cond ((not (file-directory-p newname))
    5588             :              ;; If NEWNAME is not an existing directory, create it;
    5589             :              ;; that is where we will copy the files of DIRECTORY.
    5590           4 :              (make-directory newname parents))
    5591             :             ;; If NEWNAME is an existing directory and COPY-CONTENTS
    5592             :             ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
    5593           4 :             ((not copy-contents)
    5594           2 :              (setq newname (expand-file-name
    5595           2 :                             (file-name-nondirectory
    5596           2 :                              (directory-file-name directory))
    5597           2 :                             newname))
    5598           2 :              (and (file-exists-p newname)
    5599           0 :                   (not (file-directory-p newname))
    5600           0 :                   (error "Cannot overwrite non-directory %s with a directory"
    5601           2 :                          newname))
    5602           8 :              (make-directory newname t)))
    5603             : 
    5604             :       ;; Copy recursively.
    5605           8 :       (dolist (file
    5606             :                ;; We do not want to copy "." and "..".
    5607           8 :                (directory-files directory 'full
    5608           8 :                                 directory-files-no-dot-files-regexp))
    5609           8 :         (let ((target (expand-file-name (file-name-nondirectory file) newname))
    5610           8 :               (filetype (car (file-attributes file))))
    5611           8 :           (cond
    5612           8 :            ((eq filetype t)       ; Directory but not a symlink.
    5613           0 :             (copy-directory file newname keep-time parents))
    5614           8 :            ((stringp filetype)    ; Symbolic link
    5615           0 :             (make-symbolic-link filetype target t))
    5616           8 :            ((copy-file file target t keep-time)))))
    5617             : 
    5618             :       ;; Set directory attributes.
    5619           8 :       (let ((modes (file-modes directory))
    5620           8 :             (times (and keep-time (nth 5 (file-attributes directory)))))
    5621           8 :         (if modes (set-file-modes newname modes))
    5622          16 :         (if times (set-file-times newname times))))))
    5623             : 
    5624             : 
    5625             : ;; At time of writing, only info uses this.
    5626             : (defun prune-directory-list (dirs &optional keep reject)
    5627             :   "Return a copy of DIRS with all non-existent directories removed.
    5628             : The optional argument KEEP is a list of directories to retain even if
    5629             : they don't exist, and REJECT is a list of directories to remove from
    5630             : DIRS, even if they exist; REJECT takes precedence over KEEP.
    5631             : 
    5632             : Note that membership in REJECT and KEEP is checked using simple string
    5633             : comparison."
    5634           0 :   (apply #'nconc
    5635           0 :          (mapcar (lambda (dir)
    5636           0 :                    (and (not (member dir reject))
    5637           0 :                         (or (member dir keep) (file-directory-p dir))
    5638           0 :                         (list dir)))
    5639           0 :                  dirs)))
    5640             : 
    5641             : 
    5642             : (put 'revert-buffer-function 'permanent-local t)
    5643             : (defvar revert-buffer-function #'revert-buffer--default
    5644             :   "Function to use to revert this buffer.
    5645             : The function receives two arguments IGNORE-AUTO and NOCONFIRM,
    5646             : which are the arguments that `revert-buffer' received.
    5647             : It also has access to the `preserve-modes' argument of `revert-buffer'
    5648             : via the `revert-buffer-preserve-modes' dynamic variable.
    5649             : 
    5650             : For historical reasons, a value of nil means to use the default function.
    5651             : This should not be relied upon.")
    5652             : 
    5653             : (put 'revert-buffer-insert-file-contents-function 'permanent-local t)
    5654             : (defvar revert-buffer-insert-file-contents-function
    5655             :   #'revert-buffer-insert-file-contents--default-function
    5656             :   "Function to use to insert contents when reverting this buffer.
    5657             : The function receives two arguments: the first the nominal file name to use;
    5658             : the second is t if reading the auto-save file.
    5659             : 
    5660             : The function is responsible for updating (or preserving) point.
    5661             : 
    5662             : For historical reasons, a value of nil means to use the default function.
    5663             : This should not be relied upon.")
    5664             : 
    5665             : (defun buffer-stale--default-function (&optional _noconfirm)
    5666             :   "Default function to use for `buffer-stale-function'.
    5667             : This function ignores its argument.
    5668             : This returns non-nil if the current buffer is visiting a readable file
    5669             : whose modification time does not match that of the buffer.
    5670             : 
    5671             : This function only handles buffers that are visiting files.
    5672             : Non-file buffers need a custom function"
    5673           0 :   (and buffer-file-name
    5674           0 :        (file-readable-p buffer-file-name)
    5675           0 :        (not (buffer-modified-p (current-buffer)))
    5676           0 :        (not (verify-visited-file-modtime (current-buffer)))))
    5677             : 
    5678             : (defvar buffer-stale-function #'buffer-stale--default-function
    5679             :   "Function to check whether a buffer needs reverting.
    5680             : This should be a function with one optional argument NOCONFIRM.
    5681             : Auto Revert Mode passes t for NOCONFIRM.  The function should return
    5682             : non-nil if the buffer should be reverted.  A return value of
    5683             : `fast' means that the need for reverting was not checked, but
    5684             : that reverting the buffer is fast.  The buffer is current when
    5685             : this function is called.
    5686             : 
    5687             : The idea behind the NOCONFIRM argument is that it should be
    5688             : non-nil if the buffer is going to be reverted without asking the
    5689             : user.  In such situations, one has to be careful with potentially
    5690             : time consuming operations.
    5691             : 
    5692             : For historical reasons, a value of nil means to use the default function.
    5693             : This should not be relied upon.
    5694             : 
    5695             : For more information on how this variable is used by Auto Revert mode,
    5696             : see Info node `(emacs)Supporting additional buffers'.")
    5697             : 
    5698             : (defvar before-revert-hook nil
    5699             :   "Normal hook for `revert-buffer' to run before reverting.
    5700             : The function `revert-buffer--default' runs this.
    5701             : A customized `revert-buffer-function' need not run this hook.")
    5702             : 
    5703             : (defvar after-revert-hook nil
    5704             :   "Normal hook for `revert-buffer' to run after reverting.
    5705             : Note that the hook value that it runs is the value that was in effect
    5706             : before reverting; that makes a difference if you have buffer-local
    5707             : hook functions.
    5708             : 
    5709             : The function `revert-buffer--default' runs this.
    5710             : A customized `revert-buffer-function' need not run this hook.")
    5711             : 
    5712             : (defvar revert-buffer-in-progress-p nil
    5713             :   "Non-nil if a `revert-buffer' operation is in progress, nil otherwise.")
    5714             : 
    5715             : (defvar revert-buffer-internal-hook)
    5716             : 
    5717             : ;; `revert-buffer-function' was defined long ago to be a function of only
    5718             : ;; 2 arguments, so we have to use a dynbind variable to pass the
    5719             : ;; `preserve-modes' argument of `revert-buffer'.
    5720             : (defvar revert-buffer-preserve-modes)
    5721             : 
    5722             : (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
    5723             :   "Replace current buffer text with the text of the visited file on disk.
    5724             : This undoes all changes since the file was visited or saved.
    5725             : With a prefix argument, offer to revert from latest auto-save file, if
    5726             : that is more recent than the visited file.
    5727             : 
    5728             : This command also implements an interface for special buffers
    5729             : that contain text which doesn't come from a file, but reflects
    5730             : some other data instead (e.g. Dired buffers, `buffer-list'
    5731             : buffers).  This is done via the variable `revert-buffer-function'.
    5732             : In these cases, it should reconstruct the buffer contents from the
    5733             : appropriate data.
    5734             : 
    5735             : When called from Lisp, the first argument is IGNORE-AUTO; only offer
    5736             : to revert from the auto-save file when this is nil.  Note that the
    5737             : sense of this argument is the reverse of the prefix argument, for the
    5738             : sake of backward compatibility.  IGNORE-AUTO is optional, defaulting
    5739             : to nil.
    5740             : 
    5741             : Optional second argument NOCONFIRM means don't ask for confirmation
    5742             : at all.  (The variable `revert-without-query' offers another way to
    5743             : revert buffers without querying for confirmation.)
    5744             : 
    5745             : Optional third argument PRESERVE-MODES non-nil means don't alter
    5746             : the files modes.  Normally we reinitialize them using `normal-mode'.
    5747             : 
    5748             : This function binds `revert-buffer-in-progress-p' non-nil while it operates.
    5749             : 
    5750             : This function calls the function that `revert-buffer-function' specifies
    5751             : to do the work, with arguments IGNORE-AUTO and NOCONFIRM.
    5752             : The default function runs the hooks `before-revert-hook' and
    5753             : `after-revert-hook'."
    5754             :   ;; I admit it's odd to reverse the sense of the prefix argument, but
    5755             :   ;; there is a lot of code out there which assumes that the first
    5756             :   ;; argument should be t to avoid consulting the auto-save file, and
    5757             :   ;; there's no straightforward way to encourage authors to notice a
    5758             :   ;; reversal of the argument sense.  So I'm just changing the user
    5759             :   ;; interface, but leaving the programmatic interface the same.
    5760           0 :   (interactive (list (not current-prefix-arg)))
    5761           0 :   (let ((revert-buffer-in-progress-p t)
    5762           0 :         (revert-buffer-preserve-modes preserve-modes))
    5763           0 :     (funcall (or revert-buffer-function #'revert-buffer--default)
    5764           0 :              ignore-auto noconfirm)))
    5765             : 
    5766             : (defun revert-buffer--default (ignore-auto noconfirm)
    5767             :   "Default function for `revert-buffer'.
    5768             : The arguments IGNORE-AUTO and NOCONFIRM are as described for `revert-buffer'.
    5769             : Runs the hooks `before-revert-hook' and `after-revert-hook' at the
    5770             : start and end.
    5771             : 
    5772             : Calls `revert-buffer-insert-file-contents-function' to reread the
    5773             : contents of the visited file, with two arguments: the first is the file
    5774             : name, the second is non-nil if reading an auto-save file.
    5775             : 
    5776             : This function only handles buffers that are visiting files.
    5777             : Non-file buffers need a custom function."
    5778           0 :   (with-current-buffer (or (buffer-base-buffer (current-buffer))
    5779           0 :                            (current-buffer))
    5780           0 :     (let* ((auto-save-p (and (not ignore-auto)
    5781           0 :                              (recent-auto-save-p)
    5782           0 :                              buffer-auto-save-file-name
    5783           0 :                              (file-readable-p buffer-auto-save-file-name)
    5784           0 :                              (y-or-n-p
    5785           0 :                               "Buffer has been auto-saved recently.  Revert from auto-save file? ")))
    5786           0 :            (file-name (if auto-save-p
    5787           0 :                           buffer-auto-save-file-name
    5788           0 :                         buffer-file-name)))
    5789           0 :       (cond ((null file-name)
    5790           0 :              (error "Buffer does not seem to be associated with any file"))
    5791           0 :             ((or noconfirm
    5792           0 :                  (and (not (buffer-modified-p))
    5793           0 :                       (catch 'found
    5794           0 :                         (dolist (regexp revert-without-query)
    5795           0 :                           (when (string-match regexp file-name)
    5796           0 :                             (throw 'found t)))))
    5797           0 :                  (yes-or-no-p (format "Revert buffer from file %s? "
    5798           0 :                                       file-name)))
    5799           0 :              (run-hooks 'before-revert-hook)
    5800             :              ;; If file was backed up but has changed since,
    5801             :              ;; we should make another backup.
    5802           0 :              (and (not auto-save-p)
    5803           0 :                   (not (verify-visited-file-modtime (current-buffer)))
    5804           0 :                   (setq buffer-backed-up nil))
    5805             :              ;; Effectively copy the after-revert-hook status,
    5806             :              ;; since after-find-file will clobber it.
    5807           0 :              (let ((global-hook (default-value 'after-revert-hook))
    5808           0 :                    (local-hook (when (local-variable-p 'after-revert-hook)
    5809           0 :                                  after-revert-hook))
    5810             :                    (inhibit-read-only t))
    5811             :                ;; FIXME: Throw away undo-log when preserve-modes is nil?
    5812           0 :                (funcall
    5813           0 :                 (or revert-buffer-insert-file-contents-function
    5814           0 :                     #'revert-buffer-insert-file-contents--default-function)
    5815           0 :                 file-name auto-save-p)
    5816             :                ;; Recompute the truename in case changes in symlinks
    5817             :                ;; have changed the truename.
    5818           0 :                (setq buffer-file-truename
    5819           0 :                      (abbreviate-file-name (file-truename buffer-file-name)))
    5820           0 :                (after-find-file nil nil t nil revert-buffer-preserve-modes)
    5821             :                ;; Run after-revert-hook as it was before we reverted.
    5822           0 :                (setq-default revert-buffer-internal-hook global-hook)
    5823           0 :                (if local-hook
    5824           0 :                    (set (make-local-variable 'revert-buffer-internal-hook)
    5825           0 :                         local-hook)
    5826           0 :                  (kill-local-variable 'revert-buffer-internal-hook))
    5827           0 :                (run-hooks 'revert-buffer-internal-hook))
    5828           0 :              t)))))
    5829             : 
    5830             : (defun revert-buffer-insert-file-contents--default-function (file-name auto-save-p)
    5831             :   "Default function for `revert-buffer-insert-file-contents-function'.
    5832             : The function `revert-buffer--default' calls this.
    5833             : FILE-NAME is the name of the file.  AUTO-SAVE-P is non-nil if this is
    5834             : an auto-save file."
    5835           0 :   (cond
    5836           0 :    ((not (file-exists-p file-name))
    5837           0 :     (error (if buffer-file-number
    5838             :                "File %s no longer exists!"
    5839           0 :              "Cannot revert nonexistent file %s")
    5840           0 :            file-name))
    5841           0 :    ((not (file-readable-p file-name))
    5842           0 :     (error (if buffer-file-number
    5843             :                "File %s no longer readable!"
    5844           0 :              "Cannot revert unreadable file %s")
    5845           0 :            file-name))
    5846             :    (t
    5847             :     ;; Bind buffer-file-name to nil
    5848             :     ;; so that we don't try to lock the file.
    5849           0 :     (let ((buffer-file-name nil))
    5850           0 :       (or auto-save-p
    5851           0 :           (unlock-buffer)))
    5852           0 :     (widen)
    5853           0 :     (let ((coding-system-for-read
    5854             :            ;; Auto-saved file should be read by Emacs's
    5855             :            ;; internal coding.
    5856           0 :            (if auto-save-p 'auto-save-coding
    5857           0 :              (or coding-system-for-read
    5858           0 :                  (and
    5859           0 :                   buffer-file-coding-system-explicit
    5860           0 :                   (car buffer-file-coding-system-explicit))))))
    5861           0 :       (if (and (not enable-multibyte-characters)
    5862           0 :                coding-system-for-read
    5863           0 :                (not (memq (coding-system-base
    5864           0 :                            coding-system-for-read)
    5865           0 :                           '(no-conversion raw-text))))
    5866             :           ;; As a coding system suitable for multibyte
    5867             :           ;; buffer is specified, make the current
    5868             :           ;; buffer multibyte.
    5869           0 :           (set-buffer-multibyte t))
    5870             : 
    5871             :       ;; This force after-insert-file-set-coding
    5872             :       ;; (called from insert-file-contents) to set
    5873             :       ;; buffer-file-coding-system to a proper value.
    5874           0 :       (kill-local-variable 'buffer-file-coding-system)
    5875             : 
    5876             :       ;; Note that this preserves point in an intelligent way.
    5877           0 :       (if revert-buffer-preserve-modes
    5878           0 :           (let ((buffer-file-format buffer-file-format))
    5879           0 :             (insert-file-contents file-name (not auto-save-p)
    5880           0 :                                   nil nil t))
    5881           0 :         (insert-file-contents file-name (not auto-save-p)
    5882           0 :                               nil nil t))))))
    5883             : 
    5884             : (defun recover-this-file ()
    5885             :   "Recover the visited file--get contents from its last auto-save file."
    5886             :   (interactive)
    5887           0 :   (or buffer-file-name
    5888           0 :       (user-error "This buffer is not visiting a file"))
    5889           0 :   (recover-file buffer-file-name))
    5890             : 
    5891             : (defun recover-file (file)
    5892             :   "Visit file FILE, but get contents from its last auto-save file."
    5893             :   ;; Actually putting the file name in the minibuffer should be used
    5894             :   ;; only rarely.
    5895             :   ;; Not just because users often use the default.
    5896             :   (interactive "FRecover file: ")
    5897           0 :   (setq file (expand-file-name file))
    5898           0 :   (if (auto-save-file-name-p (file-name-nondirectory file))
    5899           0 :       (error "%s is an auto-save file" (abbreviate-file-name file)))
    5900           0 :   (let ((file-name (let ((buffer-file-name file))
    5901           0 :                      (make-auto-save-file-name))))
    5902           0 :     (cond ((if (file-exists-p file)
    5903           0 :                (not (file-newer-than-file-p file-name file))
    5904           0 :              (not (file-exists-p file-name)))
    5905           0 :            (error "Auto-save file %s not current"
    5906           0 :                   (abbreviate-file-name file-name)))
    5907           0 :           ((with-temp-buffer-window
    5908             :             "*Directory*" nil
    5909           0 :             #'(lambda (window _value)
    5910           0 :                 (with-selected-window window
    5911           0 :                   (unwind-protect
    5912           0 :                       (yes-or-no-p (format "Recover auto save file %s? " file-name))
    5913           0 :                     (when (window-live-p window)
    5914           0 :                       (quit-restore-window window 'kill)))))
    5915           0 :             (with-current-buffer standard-output
    5916           0 :               (let ((switches dired-listing-switches))
    5917           0 :                 (if (file-symlink-p file)
    5918           0 :                     (setq switches (concat switches " -L")))
    5919             :                 ;; Use insert-directory-safely, not insert-directory,
    5920             :                 ;; because these files might not exist.  In particular,
    5921             :                 ;; FILE might not exist if the auto-save file was for
    5922             :                 ;; a buffer that didn't visit a file, such as "*mail*".
    5923             :                 ;; The code in v20.x called `ls' directly, so we need
    5924             :                 ;; to emulate what `ls' did in that case.
    5925           0 :                 (insert-directory-safely file switches)
    5926           0 :                 (insert-directory-safely file-name switches))))
    5927           0 :            (switch-to-buffer (find-file-noselect file t))
    5928           0 :            (let ((inhibit-read-only t)
    5929             :                  ;; Keep the current buffer-file-coding-system.
    5930           0 :                  (coding-system buffer-file-coding-system)
    5931             :                  ;; Auto-saved file should be read with special coding.
    5932             :                  (coding-system-for-read 'auto-save-coding))
    5933           0 :              (erase-buffer)
    5934           0 :              (insert-file-contents file-name nil)
    5935           0 :              (set-buffer-file-coding-system coding-system))
    5936           0 :            (after-find-file nil nil t))
    5937           0 :           (t (user-error "Recover-file canceled")))))
    5938             : 
    5939             : (defun recover-session ()
    5940             :   "Recover auto save files from a previous Emacs session.
    5941             : This command first displays a Dired buffer showing you the
    5942             : previous sessions that you could recover from.
    5943             : To choose one, move point to the proper line and then type C-c C-c.
    5944             : Then you'll be asked about a number of files to recover."
    5945             :   (interactive)
    5946           0 :   (if (null auto-save-list-file-prefix)
    5947           0 :       (error "You set `auto-save-list-file-prefix' to disable making session files"))
    5948           0 :   (let ((dir (file-name-directory auto-save-list-file-prefix))
    5949           0 :         (nd (file-name-nondirectory auto-save-list-file-prefix)))
    5950           0 :     (unless (file-directory-p dir)
    5951           0 :       (make-directory dir t))
    5952           0 :     (unless (directory-files dir nil
    5953           0 :                              (if (string= "" nd)
    5954           0 :                                  directory-files-no-dot-files-regexp
    5955           0 :                                (concat "\\`" (regexp-quote nd)))
    5956           0 :                              t)
    5957           0 :       (error "No previous sessions to recover")))
    5958           0 :   (let ((ls-lisp-support-shell-wildcards t))
    5959           0 :     (dired (concat auto-save-list-file-prefix "*")
    5960           0 :            (concat dired-listing-switches " -t")))
    5961           0 :   (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
    5962           0 :   (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)
    5963           0 :   (save-excursion
    5964           0 :     (goto-char (point-min))
    5965           0 :     (or (looking-at " Move to the session you want to recover,")
    5966           0 :         (let ((inhibit-read-only t))
    5967             :           ;; Each line starts with a space
    5968             :           ;; so that Font Lock mode won't highlight the first character.
    5969           0 :           (insert " To recover a session, move to it and type C-c C-c.\n"
    5970           0 :                   (substitute-command-keys
    5971             :                    " To delete a session file, type \
    5972             : \\[dired-flag-file-deletion] on its line to flag
    5973             :  the file for deletion, then \\[dired-do-flagged-delete] to \
    5974           0 : delete flagged files.\n\n"))))))
    5975             : 
    5976             : (defun recover-session-finish ()
    5977             :   "Choose one saved session to recover auto-save files from.
    5978             : This command is used in the special Dired buffer created by
    5979             : \\[recover-session]."
    5980             :   (interactive)
    5981             :   ;; Get the name of the session file to recover from.
    5982           0 :   (let ((file (dired-get-filename))
    5983             :         files
    5984           0 :         (buffer (get-buffer-create " *recover*")))
    5985           0 :     (dired-unmark 1)
    5986           0 :     (dired-do-flagged-delete t)
    5987           0 :     (unwind-protect
    5988           0 :         (with-current-buffer buffer
    5989             :           ;; Read in the auto-save-list file.
    5990           0 :           (erase-buffer)
    5991           0 :           (insert-file-contents file)
    5992             :           ;; Loop thru the text of that file
    5993             :           ;; and get out the names of the files to recover.
    5994           0 :           (while (not (eobp))
    5995           0 :             (let (thisfile autofile)
    5996           0 :               (if (eolp)
    5997             :                   ;; This is a pair of lines for a non-file-visiting buffer.
    5998             :                   ;; Get the auto-save file name and manufacture
    5999             :                   ;; a "visited file name" from that.
    6000           0 :                   (progn
    6001           0 :                     (forward-line 1)
    6002             :                     ;; If there is no auto-save file name, the
    6003             :                     ;; auto-save-list file is probably corrupted.
    6004           0 :                     (unless (eolp)
    6005           0 :                       (setq autofile
    6006           0 :                             (buffer-substring-no-properties
    6007           0 :                              (point)
    6008           0 :                              (line-end-position)))
    6009           0 :                       (setq thisfile
    6010           0 :                             (expand-file-name
    6011           0 :                              (substring
    6012           0 :                               (file-name-nondirectory autofile)
    6013           0 :                               1 -1)
    6014           0 :                              (file-name-directory autofile))))
    6015           0 :                     (forward-line 1))
    6016             :                 ;; This pair of lines is a file-visiting
    6017             :                 ;; buffer.  Use the visited file name.
    6018           0 :                 (progn
    6019           0 :                   (setq thisfile
    6020           0 :                         (buffer-substring-no-properties
    6021           0 :                          (point) (progn (end-of-line) (point))))
    6022           0 :                   (forward-line 1)
    6023           0 :                   (setq autofile
    6024           0 :                         (buffer-substring-no-properties
    6025           0 :                          (point) (progn (end-of-line) (point))))
    6026           0 :                   (forward-line 1)))
    6027             :               ;; Ignore a file if its auto-save file does not exist now.
    6028           0 :               (if (and autofile (file-exists-p autofile))
    6029           0 :                   (setq files (cons thisfile files)))))
    6030           0 :           (setq files (nreverse files))
    6031             :           ;; The file contains a pair of line for each auto-saved buffer.
    6032             :           ;; The first line of the pair contains the visited file name
    6033             :           ;; or is empty if the buffer was not visiting a file.
    6034             :           ;; The second line is the auto-save file name.
    6035           0 :           (if files
    6036           0 :               (map-y-or-n-p  "Recover %s? "
    6037             :                              (lambda (file)
    6038           0 :                                (condition-case nil
    6039           0 :                                    (save-excursion (recover-file file))
    6040             :                                  (error
    6041           0 :                                   "Failed to recover `%s'" file)))
    6042           0 :                              files
    6043           0 :                              '("file" "files" "recover"))
    6044           0 :             (message "No files can be recovered from this session now")))
    6045           0 :       (kill-buffer buffer))))
    6046             : 
    6047             : (defun kill-buffer-ask (buffer)
    6048             :   "Kill BUFFER if confirmed."
    6049           0 :   (when (yes-or-no-p (format "Buffer %s %s.  Kill? "
    6050           0 :                              (buffer-name buffer)
    6051           0 :                              (if (buffer-modified-p buffer)
    6052           0 :                                  "HAS BEEN EDITED" "is unmodified")))
    6053           0 :     (kill-buffer buffer)))
    6054             : 
    6055             : (defun kill-some-buffers (&optional list)
    6056             :   "Kill some buffers.  Asks the user whether to kill each one of them.
    6057             : Non-interactively, if optional argument LIST is non-nil, it
    6058             : specifies the list of buffers to kill, asking for approval for each one."
    6059             :   (interactive)
    6060           0 :   (if (null list)
    6061           0 :       (setq list (buffer-list)))
    6062           0 :   (while list
    6063           0 :     (let* ((buffer (car list))
    6064           0 :            (name (buffer-name buffer)))
    6065           0 :       (and name                         ; Can be nil for an indirect buffer
    6066             :                                         ; if we killed the base buffer.
    6067           0 :            (not (string-equal name ""))
    6068           0 :            (/= (aref name 0) ?\s)
    6069           0 :            (kill-buffer-ask buffer)))
    6070           0 :     (setq list (cdr list))))
    6071             : 
    6072             : (defun kill-matching-buffers (regexp &optional internal-too no-ask)
    6073             :   "Kill buffers whose name matches the specified REGEXP.
    6074             : Ignores buffers whose name starts with a space, unless optional
    6075             : prefix argument INTERNAL-TOO is non-nil.  Asks before killing
    6076             : each buffer, unless NO-ASK is non-nil."
    6077             :   (interactive "sKill buffers matching this regular expression: \nP")
    6078           0 :   (dolist (buffer (buffer-list))
    6079           0 :     (let ((name (buffer-name buffer)))
    6080           0 :       (when (and name (not (string-equal name ""))
    6081           0 :                  (or internal-too (/= (aref name 0) ?\s))
    6082           0 :                  (string-match regexp name))
    6083           0 :         (funcall (if no-ask 'kill-buffer 'kill-buffer-ask) buffer)))))
    6084             : 
    6085             : 
    6086             : (defun rename-auto-save-file ()
    6087             :   "Adjust current buffer's auto save file name for current conditions.
    6088             : Also rename any existing auto save file, if it was made in this session."
    6089           0 :   (let ((osave buffer-auto-save-file-name))
    6090           0 :     (setq buffer-auto-save-file-name
    6091           0 :           (make-auto-save-file-name))
    6092           0 :     (if (and osave buffer-auto-save-file-name
    6093           0 :              (not (string= buffer-auto-save-file-name buffer-file-name))
    6094           0 :              (not (string= buffer-auto-save-file-name osave))
    6095           0 :              (file-exists-p osave)
    6096           0 :              (recent-auto-save-p))
    6097           0 :         (rename-file osave buffer-auto-save-file-name t))))
    6098             : 
    6099             : (defun make-auto-save-file-name ()
    6100             :   "Return file name to use for auto-saves of current buffer.
    6101             : Does not consider `auto-save-visited-file-name' as that variable is checked
    6102             : before calling this function.  You can redefine this for customization.
    6103             : See also `auto-save-file-name-p'."
    6104           8 :   (if buffer-file-name
    6105           8 :       (let ((handler (find-file-name-handler buffer-file-name
    6106           8 :                                              'make-auto-save-file-name)))
    6107           8 :         (if handler
    6108           4 :             (funcall handler 'make-auto-save-file-name)
    6109           4 :           (let ((list auto-save-file-name-transforms)
    6110           4 :                 (filename buffer-file-name)
    6111             :                 result uniq)
    6112             :             ;; Apply user-specified translations
    6113             :             ;; to the file name.
    6114           6 :             (while (and list (not result))
    6115           2 :               (if (string-match (car (car list)) filename)
    6116           2 :                   (setq result (replace-match (cadr (car list)) t nil
    6117           2 :                                               filename)
    6118           2 :                         uniq (car (cddr (car list)))))
    6119           4 :               (setq list (cdr list)))
    6120           4 :             (if result
    6121           2 :                 (if uniq
    6122           2 :                     (setq filename (concat
    6123           2 :                                     (file-name-directory result)
    6124           2 :                                     (subst-char-in-string
    6125             :                                      ?/ ?!
    6126           2 :                                      (replace-regexp-in-string "!" "!!"
    6127           2 :                                                                filename))))
    6128           4 :                   (setq filename result)))
    6129           4 :             (setq result
    6130           4 :                   (if (and (eq system-type 'ms-dos)
    6131           4 :                            (not (msdos-long-file-names)))
    6132             :                       ;; We truncate the file name to DOS 8+3 limits
    6133             :                       ;; before doing anything else, because the regexp
    6134             :                       ;; passed to string-match below cannot handle
    6135             :                       ;; extensions longer than 3 characters, multiple
    6136             :                       ;; dots, and other atrocities.
    6137           0 :                       (let ((fn (dos-8+3-filename
    6138           0 :                                  (file-name-nondirectory buffer-file-name))))
    6139           0 :                         (string-match
    6140             :                          "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
    6141           0 :                          fn)
    6142           0 :                         (concat (file-name-directory buffer-file-name)
    6143           0 :                                 "#" (match-string 1 fn)
    6144           0 :                                 "." (match-string 3 fn) "#"))
    6145           4 :                     (concat (file-name-directory filename)
    6146             :                             "#"
    6147           4 :                             (file-name-nondirectory filename)
    6148           4 :                             "#")))
    6149             :             ;; Make sure auto-save file names don't contain characters
    6150             :             ;; invalid for the underlying filesystem.
    6151           4 :             (if (and (memq system-type '(ms-dos windows-nt cygwin))
    6152             :                      ;; Don't modify remote filenames
    6153           4 :                      (not (file-remote-p result)))
    6154           0 :                 (convert-standard-filename result)
    6155           8 :               result))))
    6156             : 
    6157             :     ;; Deal with buffers that don't have any associated files.  (Mail
    6158             :     ;; mode tends to create a good number of these.)
    6159             : 
    6160           0 :     (let ((buffer-name (buffer-name))
    6161             :           (limit 0)
    6162             :           file-name)
    6163             :       ;; Restrict the characters used in the file name to those which
    6164             :       ;; are known to be safe on all filesystems, url-encoding the
    6165             :       ;; rest.
    6166             :       ;; We do this on all platforms, because even if we are not
    6167             :       ;; running on DOS/Windows, the current directory may be on a
    6168             :       ;; mounted VFAT filesystem, such as a USB memory stick.
    6169           0 :       (while (string-match "[^A-Za-z0-9-_.~#+]" buffer-name limit)
    6170           0 :         (let* ((character (aref buffer-name (match-beginning 0)))
    6171             :                (replacement
    6172             :                 ;; For multibyte characters, this will produce more than
    6173             :                 ;; 2 hex digits, so is not true URL encoding.
    6174           0 :                 (format "%%%02X" character)))
    6175           0 :           (setq buffer-name (replace-match replacement t t buffer-name))
    6176           0 :           (setq limit (1+ (match-end 0)))))
    6177             :       ;; Generate the file name.
    6178           0 :       (setq file-name
    6179           0 :             (make-temp-file
    6180           0 :              (let ((fname
    6181           0 :                     (expand-file-name
    6182           0 :                      (format "#%s#" buffer-name)
    6183             :                      ;; Try a few alternative directories, to get one we can
    6184             :                      ;; write it.
    6185           0 :                      (cond
    6186           0 :                       ((file-writable-p default-directory) default-directory)
    6187           0 :                       ((file-writable-p "/var/tmp/") "/var/tmp/")
    6188           0 :                       ("~/")))))
    6189           0 :                (if (and (memq system-type '(ms-dos windows-nt cygwin))
    6190             :                         ;; Don't modify remote filenames
    6191           0 :                         (not (file-remote-p fname)))
    6192             :                    ;; The call to convert-standard-filename is in case
    6193             :                    ;; buffer-name includes characters not allowed by the
    6194             :                    ;; DOS/Windows filesystems.  make-temp-file writes to the
    6195             :                    ;; file it creates, so we must fix the file name _before_
    6196             :                    ;; make-temp-file is called.
    6197           0 :                    (convert-standard-filename fname)
    6198           0 :                  fname))
    6199           0 :              nil "#"))
    6200             :       ;; make-temp-file creates the file,
    6201             :       ;; but we don't want it to exist until we do an auto-save.
    6202           0 :       (condition-case ()
    6203           0 :           (delete-file file-name)
    6204           0 :         (file-error nil))
    6205           8 :       file-name)))
    6206             : 
    6207             : (defun auto-save-file-name-p (filename)
    6208             :   "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
    6209             : FILENAME should lack slashes.  You can redefine this for customization."
    6210           0 :   (string-match "\\`#.*#\\'" filename))
    6211             : 
    6212             : (defun wildcard-to-regexp (wildcard)
    6213             :   "Given a shell file name pattern WILDCARD, return an equivalent regexp.
    6214             : The generated regexp will match a filename only if the filename
    6215             : matches that wildcard according to shell rules.  Only wildcards known
    6216             : by `sh' are supported."
    6217           0 :   (let* ((i (string-match "[[.*+\\^$?]" wildcard))
    6218             :          ;; Copy the initial run of non-special characters.
    6219           0 :          (result (substring wildcard 0 i))
    6220           0 :          (len (length wildcard)))
    6221             :     ;; If no special characters, we're almost done.
    6222           0 :     (if i
    6223           0 :         (while (< i len)
    6224           0 :           (let ((ch (aref wildcard i))
    6225             :                 j)
    6226           0 :             (setq
    6227             :              result
    6228           0 :              (concat result
    6229           0 :                      (cond
    6230           0 :                       ((and (eq ch ?\[)
    6231           0 :                             (< (1+ i) len)
    6232           0 :                             (eq (aref wildcard (1+ i)) ?\]))
    6233             :                        "\\[")
    6234           0 :                       ((eq ch ?\[)      ; [...] maps to regexp char class
    6235           0 :                        (progn
    6236           0 :                          (setq i (1+ i))
    6237           0 :                          (concat
    6238           0 :                           (cond
    6239           0 :                            ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
    6240           0 :                             (progn
    6241           0 :                               (setq i (1+ i))
    6242           0 :                               (if (eq (aref wildcard i) ?\])
    6243           0 :                                   (progn
    6244           0 :                                     (setq i (1+ i))
    6245           0 :                                     "[^]")
    6246           0 :                                 "[^")))
    6247           0 :                            ((eq (aref wildcard i) ?^)
    6248             :                             ;; Found "[^".  Insert a `\0' character
    6249             :                             ;; (which cannot happen in a filename)
    6250             :                             ;; into the character class, so that `^'
    6251             :                             ;; is not the first character after `[',
    6252             :                             ;; and thus non-special in a regexp.
    6253           0 :                             (progn
    6254           0 :                               (setq i (1+ i))
    6255           0 :                               "[\000^"))
    6256           0 :                            ((eq (aref wildcard i) ?\])
    6257             :                             ;; I don't think `]' can appear in a
    6258             :                             ;; character class in a wildcard, but
    6259             :                             ;; let's be general here.
    6260           0 :                             (progn
    6261           0 :                               (setq i (1+ i))
    6262           0 :                               "[]"))
    6263           0 :                            (t "["))
    6264           0 :                           (prog1        ; copy everything upto next `]'.
    6265           0 :                               (substring wildcard
    6266           0 :                                          i
    6267           0 :                                          (setq j (string-match
    6268           0 :                                                   "]" wildcard i)))
    6269           0 :                             (setq i (if j (1- j) (1- len)))))))
    6270           0 :                       ((eq ch ?.)  "\\.")
    6271           0 :                       ((eq ch ?*)  "[^\000]*")
    6272           0 :                       ((eq ch ?+)  "\\+")
    6273           0 :                       ((eq ch ?^)  "\\^")
    6274           0 :                       ((eq ch ?$)  "\\$")
    6275           0 :                       ((eq ch ?\\) "\\\\") ; probably cannot happen...
    6276           0 :                       ((eq ch ??)  "[^\000]")
    6277           0 :                       (t (char-to-string ch)))))
    6278           0 :             (setq i (1+ i)))))
    6279             :     ;; Shell wildcards should match the entire filename,
    6280             :     ;; not its part.  Make the regexp say so.
    6281           0 :     (concat "\\`" result "\\'")))
    6282             : 
    6283             : (defcustom list-directory-brief-switches
    6284             :   (purecopy "-CF")
    6285             :   "Switches for `list-directory' to pass to `ls' for brief listing."
    6286             :   :type 'string
    6287             :   :group 'dired)
    6288             : 
    6289             : (defcustom list-directory-verbose-switches
    6290             :     (purecopy "-l")
    6291             :   "Switches for `list-directory' to pass to `ls' for verbose listing."
    6292             :   :type 'string
    6293             :   :group 'dired)
    6294             : 
    6295             : (defun file-expand-wildcards (pattern &optional full)
    6296             :   "Expand wildcard pattern PATTERN.
    6297             : This returns a list of file names which match the pattern.
    6298             : Files are sorted in `string<' order.
    6299             : 
    6300             : If PATTERN is written as an absolute file name,
    6301             : the values are absolute also.
    6302             : 
    6303             : If PATTERN is written as a relative file name, it is interpreted
    6304             : relative to the current default directory, `default-directory'.
    6305             : The file names returned are normally also relative to the current
    6306             : default directory.  However, if FULL is non-nil, they are absolute."
    6307           0 :   (save-match-data
    6308           0 :     (let* ((nondir (file-name-nondirectory pattern))
    6309           0 :            (dirpart (file-name-directory pattern))
    6310             :            ;; A list of all dirs that DIRPART specifies.
    6311             :            ;; This can be more than one dir
    6312             :            ;; if DIRPART contains wildcards.
    6313           0 :            (dirs (if (and dirpart
    6314           0 :                           (string-match "[[*?]" (file-local-name dirpart)))
    6315           0 :                      (mapcar 'file-name-as-directory
    6316           0 :                              (file-expand-wildcards (directory-file-name dirpart)))
    6317           0 :                    (list dirpart)))
    6318             :            contents)
    6319           0 :       (dolist (dir dirs)
    6320           0 :         (when (or (null dir)    ; Possible if DIRPART is not wild.
    6321           0 :                   (file-accessible-directory-p dir))
    6322           0 :           (let ((this-dir-contents
    6323             :                  ;; Filter out "." and ".."
    6324           0 :                  (delq nil
    6325           0 :                        (mapcar #'(lambda (name)
    6326           0 :                                    (unless (string-match "\\`\\.\\.?\\'"
    6327           0 :                                                          (file-name-nondirectory name))
    6328           0 :                                      name))
    6329           0 :                                (directory-files (or dir ".") full
    6330           0 :                                                 (wildcard-to-regexp nondir))))))
    6331           0 :             (setq contents
    6332           0 :                   (nconc
    6333           0 :                    (if (and dir (not full))
    6334           0 :                        (mapcar #'(lambda (name) (concat dir name))
    6335           0 :                                this-dir-contents)
    6336           0 :                      this-dir-contents)
    6337           0 :                    contents)))))
    6338           0 :       contents)))
    6339             : 
    6340             : ;; Let Tramp know that `file-expand-wildcards' does not need an advice.
    6341             : (provide 'files '(remote-wildcards))
    6342             : 
    6343             : (defun list-directory (dirname &optional verbose)
    6344             :   "Display a list of files in or matching DIRNAME, a la `ls'.
    6345             : DIRNAME is globbed by the shell if necessary.
    6346             : Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
    6347             : Actions controlled by variables `list-directory-brief-switches'
    6348             : and `list-directory-verbose-switches'."
    6349           0 :   (interactive (let ((pfx current-prefix-arg))
    6350           0 :                  (list (read-directory-name (if pfx "List directory (verbose): "
    6351           0 :                                          "List directory (brief): ")
    6352           0 :                                        nil default-directory nil)
    6353           0 :                        pfx)))
    6354           0 :   (let ((switches (if verbose list-directory-verbose-switches
    6355           0 :                     list-directory-brief-switches))
    6356             :         buffer)
    6357           0 :     (or dirname (setq dirname default-directory))
    6358           0 :     (setq dirname (expand-file-name dirname))
    6359           0 :     (with-output-to-temp-buffer "*Directory*"
    6360           0 :       (setq buffer standard-output)
    6361           0 :       (buffer-disable-undo standard-output)
    6362           0 :       (princ "Directory ")
    6363           0 :       (princ dirname)
    6364           0 :       (terpri)
    6365           0 :       (with-current-buffer "*Directory*"
    6366           0 :         (let ((wildcard (not (file-directory-p dirname))))
    6367           0 :           (insert-directory dirname switches wildcard (not wildcard)))))
    6368             :     ;; Finishing with-output-to-temp-buffer seems to clobber default-directory.
    6369           0 :     (with-current-buffer buffer
    6370           0 :       (setq default-directory
    6371           0 :             (if (file-directory-p dirname)
    6372           0 :                 (file-name-as-directory dirname)
    6373           0 :               (file-name-directory dirname))))))
    6374             : 
    6375             : (defun shell-quote-wildcard-pattern (pattern)
    6376             :   "Quote characters special to the shell in PATTERN, leave wildcards alone.
    6377             : 
    6378             : PATTERN is assumed to represent a file-name wildcard suitable for the
    6379             : underlying filesystem.  For Unix and GNU/Linux, each character from the
    6380             : set [ \\t\\n;<>&|()\\=`\\='\"#$] is quoted with a backslash; for DOS/Windows, all
    6381             : the parts of the pattern which don't include wildcard characters are
    6382             : quoted with double quotes.
    6383             : 
    6384             : This function leaves alone existing quote characters (\\ on Unix and \"
    6385             : on Windows), so PATTERN can use them to quote wildcard characters that
    6386             : need to be passed verbatim to shell commands."
    6387           0 :   (save-match-data
    6388           0 :     (cond
    6389           0 :      ((memq system-type '(ms-dos windows-nt cygwin))
    6390             :       ;; DOS/Windows don't allow `"' in file names.  So if the
    6391             :       ;; argument has quotes, we can safely assume it is already
    6392             :       ;; quoted by the caller.
    6393           0 :       (if (or (string-match "[\"]" pattern)
    6394             :               ;; We quote [&()#$`'] in case their shell is a port of a
    6395             :               ;; Unixy shell.  We quote [,=+] because stock DOS and
    6396             :               ;; Windows shells require that in some cases, such as
    6397             :               ;; passing arguments to batch files that use positional
    6398             :               ;; arguments like %1.
    6399           0 :               (not (string-match "[ \t;&()#$`',=+]" pattern)))
    6400           0 :           pattern
    6401           0 :         (let ((result "\"")
    6402             :               (beg 0)
    6403             :               end)
    6404           0 :           (while (string-match "[*?]+" pattern beg)
    6405           0 :             (setq end (match-beginning 0)
    6406           0 :                   result (concat result (substring pattern beg end)
    6407             :                                  "\""
    6408           0 :                                  (substring pattern end (match-end 0))
    6409           0 :                                  "\"")
    6410           0 :                   beg (match-end 0)))
    6411           0 :           (concat result (substring pattern beg) "\""))))
    6412             :      (t
    6413           0 :       (let ((beg 0))
    6414           0 :         (while (string-match "[ \t\n;<>&|()`'\"#$]" pattern beg)
    6415           0 :           (setq pattern
    6416           0 :                 (concat (substring pattern 0 (match-beginning 0))
    6417             :                         "\\"
    6418           0 :                         (substring pattern (match-beginning 0)))
    6419           0 :                 beg (1+ (match-end 0)))))
    6420           0 :       pattern))))
    6421             : 
    6422             : 
    6423             : (defvar insert-directory-program (purecopy "ls")
    6424             :   "Absolute or relative name of the `ls' program used by `insert-directory'.")
    6425             : 
    6426             : (defcustom directory-free-space-program (purecopy "df")
    6427             :   "Program to get the amount of free space on a file system.
    6428             : We assume the output has the format of `df'.
    6429             : The value of this variable must be just a command name or file name;
    6430             : if you want to specify options, use `directory-free-space-args'.
    6431             : 
    6432             : A value of nil disables this feature.
    6433             : 
    6434             : If the function `file-system-info' is defined, it is always used in
    6435             : preference to the program given by this variable."
    6436             :   :type '(choice (string :tag "Program") (const :tag "None" nil))
    6437             :   :group 'dired)
    6438             : 
    6439             : (defcustom directory-free-space-args
    6440             :   (purecopy (if (eq system-type 'darwin) "-k" "-Pk"))
    6441             :   "Options to use when running `directory-free-space-program'."
    6442             :   :type 'string
    6443             :   :group 'dired)
    6444             : 
    6445             : (defun get-free-disk-space (dir)
    6446             :   "Return the amount of free space on directory DIR's file system.
    6447             : The return value is a string describing the amount of free
    6448             : space (normally, the number of free 1KB blocks).
    6449             : 
    6450             : This function calls `file-system-info' if it is available, or
    6451             : invokes the program specified by `directory-free-space-program'
    6452             : and `directory-free-space-args'.  If the system call or program
    6453             : is unsuccessful, or if DIR is a remote directory, this function
    6454             : returns nil."
    6455           0 :   (unless (file-remote-p (expand-file-name dir))
    6456             :     ;; Try to find the number of free blocks.  Non-Posix systems don't
    6457             :     ;; always have df, but might have an equivalent system call.
    6458           0 :     (if (fboundp 'file-system-info)
    6459           0 :         (let ((fsinfo (file-system-info dir)))
    6460           0 :           (if fsinfo
    6461           0 :               (format "%.0f" (/ (nth 2 fsinfo) 1024))))
    6462           0 :       (setq dir (expand-file-name dir))
    6463           0 :       (save-match-data
    6464           0 :         (with-temp-buffer
    6465           0 :           (when (and directory-free-space-program
    6466             :                      ;; Avoid failure if the default directory does
    6467             :                      ;; not exist (Bug#2631, Bug#3911).
    6468           0 :                      (let ((default-directory
    6469           0 :                              (locate-dominating-file dir 'file-directory-p)))
    6470           0 :                        (eq (process-file directory-free-space-program
    6471             :                                          nil t nil
    6472           0 :                                          directory-free-space-args
    6473           0 :                                          (file-relative-name dir))
    6474           0 :                            0)))
    6475             :             ;; Assume that the "available" column is before the
    6476             :             ;; "capacity" column.  Find the "%" and scan backward.
    6477           0 :             (goto-char (point-min))
    6478           0 :             (forward-line 1)
    6479           0 :             (when (re-search-forward
    6480             :                    "[[:space:]]+[^[:space:]]+%[^%]*$"
    6481           0 :                    (line-end-position) t)
    6482           0 :               (goto-char (match-beginning 0))
    6483           0 :               (let ((endpt (point)))
    6484           0 :                 (skip-chars-backward "^[:space:]")
    6485           0 :                 (buffer-substring-no-properties (point) endpt)))))))))
    6486             : 
    6487             : ;; The following expression replaces `dired-move-to-filename-regexp'.
    6488             : (defvar directory-listing-before-filename-regexp
    6489             :   (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
    6490             :          (l-or-quote "\\([A-Za-z']\\|[^\0-\177]\\)")
    6491             :          ;; In some locales, month abbreviations are as short as 2 letters,
    6492             :          ;; and they can be followed by ".".
    6493             :          ;; In Breton, a month name  can include a quote character.
    6494             :          (month (concat l-or-quote l-or-quote "+\\.?"))
    6495             :          (s " ")
    6496             :          (yyyy "[0-9][0-9][0-9][0-9]")
    6497             :          (dd "[ 0-3][0-9]")
    6498             :          (HH:MM "[ 0-2][0-9][:.][0-5][0-9]")
    6499             :          (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
    6500             :          (zone "[-+][0-2][0-9][0-5][0-9]")
    6501             :          (iso-mm-dd "[01][0-9]-[0-3][0-9]")
    6502             :          (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
    6503             :          (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
    6504             :                       "\\|" yyyy "-" iso-mm-dd "\\)"))
    6505             :          (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
    6506             :                           s "+"
    6507             :                           "\\(" HH:MM "\\|" yyyy "\\)"))
    6508             :          (western-comma (concat month s "+" dd "," s "+" yyyy))
    6509             :          ;; Japanese MS-Windows ls-lisp has one-digit months, and
    6510             :          ;; omits the Kanji characters after month and day-of-month.
    6511             :          ;; On Mac OS X 10.3, the date format in East Asian locales is
    6512             :          ;; day-of-month digits followed by month digits.
    6513             :          (mm "[ 0-1]?[0-9]")
    6514             :          (east-asian
    6515             :           (concat "\\(" mm l "?" s dd l "?" s "+"
    6516             :                   "\\|" dd s mm s "+" "\\)"
    6517             :                   "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
    6518             :          ;; The "[0-9]" below requires the previous column to end in a digit.
    6519             :          ;; This avoids recognizing `1 may 1997' as a date in the line:
    6520             :          ;; -r--r--r--   1 may      1997        1168 Oct 19 16:49 README
    6521             : 
    6522             :          ;; The "[BkKMGTPEZY]?" below supports "ls -alh" output.
    6523             : 
    6524             :          ;; For non-iso date formats, we add the ".*" in order to find
    6525             :          ;; the last possible match.  This avoids recognizing
    6526             :          ;; `jservice 10 1024' as a date in the line:
    6527             :          ;; drwxr-xr-x  3 jservice  10  1024 Jul  2  1997 esg-host
    6528             : 
    6529             :          ;; vc dired listings provide the state or blanks between file
    6530             :          ;; permissions and date.  The state is always surrounded by
    6531             :          ;; parentheses:
    6532             :          ;; -rw-r--r-- (modified) 2005-10-22 21:25 files.el
    6533             :          ;; This is not supported yet.
    6534             :     (purecopy (concat "\\([0-9][BkKMGTPEZY]? " iso
    6535             :                       "\\|.*[0-9][BkKMGTPEZY]? "
    6536             :                       "\\(" western "\\|" western-comma "\\|" east-asian "\\)"
    6537             :                       "\\) +")))
    6538             :   "Regular expression to match up to the file name in a directory listing.
    6539             : The default value is designed to recognize dates and times
    6540             : regardless of the language.")
    6541             : 
    6542             : (defvar insert-directory-ls-version 'unknown)
    6543             : 
    6544             : (defun insert-directory-wildcard-in-dir-p (dir)
    6545             :   "Return non-nil if DIR contents a shell wildcard in the directory part.
    6546             : The return value is a cons (DIR . WILDCARDS); DIR is the
    6547             : `default-directory' in the Dired buffer, and WILDCARDS are the wildcards.
    6548             : 
    6549             : Valid wildcards are '*', '?', '[abc]' and '[a-z]'."
    6550          30 :   (let ((wildcards "[?*"))
    6551          30 :     (when (and (or (not (featurep 'ls-lisp))
    6552          30 :                    ls-lisp-support-shell-wildcards)
    6553          30 :                (string-match (concat "[" wildcards "]") (file-name-directory dir))
    6554          30 :                (not (file-exists-p dir))) ; Prefer an existing file to wildcards.
    6555          20 :       (let ((regexp (format "\\`\\([^%s]*/\\)\\([^%s]*[%s].*\\)"
    6556          20 :                             wildcards wildcards wildcards)))
    6557          20 :         (string-match regexp dir)
    6558          30 :         (cons (match-string 1 dir) (match-string 2 dir))))))
    6559             : 
    6560             : (defun insert-directory-clean (beg switches)
    6561           4 :   (when (if (stringp switches)
    6562           4 :             (string-match "--dired\\>" switches)
    6563           4 :           (member "--dired" switches))
    6564             :     ;; The following overshoots by one line for an empty
    6565             :     ;; directory listed with "--dired", but without "-a"
    6566             :     ;; switch, where the ls output contains a
    6567             :     ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
    6568             :     ;; We take care of that case later.
    6569           0 :     (forward-line -2)
    6570           0 :     (when (looking-at "//SUBDIRED//")
    6571           0 :       (delete-region (point) (progn (forward-line 1) (point)))
    6572           0 :       (forward-line -1))
    6573           0 :     (if (looking-at "//DIRED//")
    6574           0 :         (let ((end (line-end-position))
    6575           0 :               (linebeg (point))
    6576             :               error-lines)
    6577             :           ;; Find all the lines that are error messages,
    6578             :           ;; and record the bounds of each one.
    6579           0 :           (goto-char beg)
    6580           0 :           (while (< (point) linebeg)
    6581           0 :             (or (eql (following-char) ?\s)
    6582           0 :                 (push (list (point) (line-end-position)) error-lines))
    6583           0 :             (forward-line 1))
    6584           0 :           (setq error-lines (nreverse error-lines))
    6585             :           ;; Now read the numeric positions of file names.
    6586           0 :           (goto-char linebeg)
    6587           0 :           (forward-word-strictly 1)
    6588           0 :           (forward-char 3)
    6589           0 :           (while (< (point) end)
    6590           0 :             (let ((start (insert-directory-adj-pos
    6591           0 :                           (+ beg (read (current-buffer)))
    6592           0 :                           error-lines))
    6593           0 :                   (end (insert-directory-adj-pos
    6594           0 :                         (+ beg (read (current-buffer)))
    6595           0 :                         error-lines)))
    6596           0 :               (if (memq (char-after end) '(?\n ?\s))
    6597             :                   ;; End is followed by \n or by " -> ".
    6598           0 :                   (put-text-property start end 'dired-filename t)
    6599             :                 ;; It seems that we can't trust ls's output as to
    6600             :                 ;; byte positions of filenames.
    6601           0 :                 (put-text-property beg (point) 'dired-filename nil)
    6602           0 :                 (end-of-line))))
    6603           0 :           (goto-char end)
    6604           0 :           (beginning-of-line)
    6605           0 :           (delete-region (point) (progn (forward-line 1) (point))))
    6606             :       ;; Take care of the case where the ls output contains a
    6607             :       ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
    6608             :       ;; and we went one line too far back (see above).
    6609           0 :       (forward-line 1))
    6610           0 :     (if (looking-at "//DIRED-OPTIONS//")
    6611           4 :         (delete-region (point) (progn (forward-line 1) (point))))))
    6612             : 
    6613             : ;; insert-directory
    6614             : ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
    6615             : ;;   FULL-DIRECTORY-P is nil.
    6616             : ;;   The single line of output must display FILE's name as it was
    6617             : ;;   given, namely, an absolute path name.
    6618             : ;; - must insert exactly one line for each file if WILDCARD or
    6619             : ;;   FULL-DIRECTORY-P is t, plus one optional "total" line
    6620             : ;;   before the file lines, plus optional text after the file lines.
    6621             : ;;   Lines are delimited by "\n", so filenames containing "\n" are not
    6622             : ;;   allowed.
    6623             : ;;   File lines should display the basename.
    6624             : ;; - must be consistent with
    6625             : ;;   - functions dired-move-to-filename, (these two define what a file line is)
    6626             : ;;               dired-move-to-end-of-filename,
    6627             : ;;               dired-between-files, (shortcut for (not (dired-move-to-filename)))
    6628             : ;;               dired-insert-headerline
    6629             : ;;               dired-after-subdir-garbage (defines what a "total" line is)
    6630             : ;;   - variable dired-subdir-regexp
    6631             : ;; - may be passed "--dired" as the first argument in SWITCHES.
    6632             : ;;   Filename handlers might have to remove this switch if their
    6633             : ;;   "ls" command does not support it.
    6634             : (defun insert-directory (file switches &optional wildcard full-directory-p)
    6635             :   "Insert directory listing for FILE, formatted according to SWITCHES.
    6636             : Leaves point after the inserted text.
    6637             : SWITCHES may be a string of options, or a list of strings
    6638             : representing individual options.
    6639             : Optional third arg WILDCARD means treat FILE as shell wildcard.
    6640             : Optional fourth arg FULL-DIRECTORY-P means file is a directory and
    6641             : switches do not contain `d', so that a full listing is expected.
    6642             : 
    6643             : This works by running a directory listing program
    6644             : whose name is in the variable `insert-directory-program'.
    6645             : If WILDCARD, it also runs the shell specified by `shell-file-name'.
    6646             : 
    6647             : When SWITCHES contains the long `--dired' option, this function
    6648             : treats it specially, for the sake of dired.  However, the
    6649             : normally equivalent short `-D' option is just passed on to
    6650             : `insert-directory-program', as any other option."
    6651             :   ;; We need the directory in order to find the right handler.
    6652          10 :   (let ((handler (find-file-name-handler (expand-file-name file)
    6653          10 :                                          'insert-directory)))
    6654          10 :     (if handler
    6655          10 :         (funcall handler 'insert-directory file switches
    6656          10 :                  wildcard full-directory-p)
    6657           0 :         (let (result (beg (point)))
    6658             : 
    6659             :           ;; Read the actual directory using `insert-directory-program'.
    6660             :           ;; RESULT gets the status code.
    6661           0 :           (let* (;; We at first read by no-conversion, then after
    6662             :                  ;; putting text property `dired-filename, decode one
    6663             :                  ;; bunch by one to preserve that property.
    6664             :                  (coding-system-for-read 'no-conversion)
    6665             :                  ;; This is to control encoding the arguments in call-process.
    6666             :                  (coding-system-for-write
    6667           0 :                   (and enable-multibyte-characters
    6668           0 :                        (or file-name-coding-system
    6669           0 :                            default-file-name-coding-system))))
    6670           0 :             (setq result
    6671           0 :                   (if wildcard
    6672             :                       ;; If the wildcard is just in the file part, then run ls in
    6673             :                       ;; the directory part of the file pattern using the last
    6674             :                       ;; component as argument.  Otherwise, run ls in the longest
    6675             :                       ;; subdirectory of the directory part free of wildcards; use
    6676             :                       ;; the remaining of the file pattern as argument.
    6677           0 :                       (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file))
    6678             :                              (default-directory
    6679           0 :                                (cond (dir-wildcard (car dir-wildcard))
    6680             :                                      (t
    6681           0 :                                       (if (file-name-absolute-p file)
    6682           0 :                                           (file-name-directory file)
    6683           0 :                                         (file-name-directory (expand-file-name file))))))
    6684           0 :                              (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file))))
    6685             :                         ;; NB since switches is passed to the shell, be
    6686             :                         ;; careful of malicious values, eg "-l;reboot".
    6687             :                         ;; See eg dired-safe-switches-p.
    6688           0 :                         (call-process
    6689           0 :                          shell-file-name nil t nil
    6690           0 :                          shell-command-switch
    6691           0 :                          (concat (if (memq system-type '(ms-dos windows-nt))
    6692             :                                      ""
    6693           0 :                                    "\\") ; Disregard Unix shell aliases!
    6694           0 :                                  insert-directory-program
    6695             :                                  " -d "
    6696           0 :                                  (if (stringp switches)
    6697           0 :                                      switches
    6698           0 :                                    (mapconcat 'identity switches " "))
    6699             :                                  " -- "
    6700             :                                  ;; Quote some characters that have
    6701             :                                  ;; special meanings in shells; but
    6702             :                                  ;; don't quote the wildcards--we want
    6703             :                                  ;; them to be special.  We also
    6704             :                                  ;; currently don't quote the quoting
    6705             :                                  ;; characters in case people want to
    6706             :                                  ;; use them explicitly to quote
    6707             :                                  ;; wildcard characters.
    6708           0 :                                  (shell-quote-wildcard-pattern pattern))))
    6709             :                     ;; SunOS 4.1.3, SVr4 and others need the "." to list the
    6710             :                     ;; directory if FILE is a symbolic link.
    6711           0 :                     (unless full-directory-p
    6712           0 :                       (setq switches
    6713           0 :                             (cond
    6714           0 :                              ((stringp switches) (concat switches " -d"))
    6715           0 :                              ((member "-d" switches) switches)
    6716           0 :                              (t (append switches '("-d"))))))
    6717           0 :                     (apply 'call-process
    6718           0 :                            insert-directory-program nil t nil
    6719           0 :                            (append
    6720           0 :                             (if (listp switches) switches
    6721           0 :                               (unless (equal switches "")
    6722             :                                 ;; Split the switches at any spaces so we can
    6723             :                                 ;; pass separate options as separate args.
    6724           0 :                                 (split-string-and-unquote switches)))
    6725             :                             ;; Avoid lossage if FILE starts with `-'.
    6726             :                             '("--")
    6727           0 :                             (progn
    6728           0 :                               (if (string-match "\\`~" file)
    6729           0 :                                   (setq file (expand-file-name file)))
    6730           0 :                               (list
    6731           0 :                                (if full-directory-p
    6732             :                                    ;; (concat (file-name-as-directory file) ".")
    6733           0 :                                    file
    6734           0 :                                  file))))))))
    6735             : 
    6736             :           ;; If we got "//DIRED//" in the output, it means we got a real
    6737             :           ;; directory listing, even if `ls' returned nonzero.
    6738             :           ;; So ignore any errors.
    6739           0 :           (when (if (stringp switches)
    6740           0 :                     (string-match "--dired\\>" switches)
    6741           0 :                   (member "--dired" switches))
    6742           0 :             (save-excursion
    6743           0 :               (forward-line -2)
    6744           0 :               (when (looking-at "//SUBDIRED//")
    6745           0 :                 (forward-line -1))
    6746           0 :               (if (looking-at "//DIRED//")
    6747           0 :                   (setq result 0))))
    6748             : 
    6749           0 :           (when (and (not (eq 0 result))
    6750           0 :                      (eq insert-directory-ls-version 'unknown))
    6751             :             ;; The first time ls returns an error,
    6752             :             ;; find the version numbers of ls,
    6753             :             ;; and set insert-directory-ls-version
    6754             :             ;; to > if it is more than 5.2.1, < if it is less, nil if it
    6755             :             ;; is equal or if the info cannot be obtained.
    6756             :             ;; (That can mean it isn't GNU ls.)
    6757           0 :             (let ((version-out
    6758           0 :                    (with-temp-buffer
    6759           0 :                      (call-process "ls" nil t nil "--version")
    6760           0 :                      (buffer-string))))
    6761           0 :               (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
    6762           0 :                   (let* ((version (match-string 1 version-out))
    6763           0 :                          (split (split-string version "[.]"))
    6764           0 :                          (numbers (mapcar 'string-to-number split))
    6765             :                          (min '(5 2 1))
    6766             :                          comparison)
    6767           0 :                     (while (and (not comparison) (or numbers min))
    6768           0 :                       (cond ((null min)
    6769           0 :                              (setq comparison '>))
    6770           0 :                             ((null numbers)
    6771           0 :                              (setq comparison '<))
    6772           0 :                             ((> (car numbers) (car min))
    6773           0 :                              (setq comparison '>))
    6774           0 :                             ((< (car numbers) (car min))
    6775           0 :                              (setq comparison '<))
    6776             :                             (t
    6777           0 :                              (setq numbers (cdr numbers)
    6778           0 :                                    min (cdr min)))))
    6779           0 :                     (setq insert-directory-ls-version (or comparison '=)))
    6780           0 :                 (setq insert-directory-ls-version nil))))
    6781             : 
    6782             :           ;; For GNU ls versions 5.2.2 and up, ignore minor errors.
    6783           0 :           (when (and (eq 1 result) (eq insert-directory-ls-version '>))
    6784           0 :             (setq result 0))
    6785             : 
    6786             :           ;; If `insert-directory-program' failed, signal an error.
    6787           0 :           (unless (eq 0 result)
    6788             :             ;; Delete the error message it may have output.
    6789           0 :             (delete-region beg (point))
    6790             :             ;; On non-Posix systems, we cannot open a directory, so
    6791             :             ;; don't even try, because that will always result in
    6792             :             ;; the ubiquitous "Access denied".  Instead, show the
    6793             :             ;; command line so the user can try to guess what went wrong.
    6794           0 :             (if (and (file-directory-p file)
    6795           0 :                      (memq system-type '(ms-dos windows-nt)))
    6796           0 :                 (error
    6797             :                  "Reading directory: \"%s %s -- %s\" exited with status %s"
    6798           0 :                  insert-directory-program
    6799           0 :                  (if (listp switches) (concat switches) switches)
    6800           0 :                  file result)
    6801             :               ;; Unix.  Access the file to get a suitable error.
    6802           0 :               (access-file file "Reading directory")
    6803           0 :               (error "Listing directory failed but `access-file' worked")))
    6804           0 :           (insert-directory-clean beg switches)
    6805             :           ;; Now decode what read if necessary.
    6806           0 :           (let ((coding (or coding-system-for-read
    6807           0 :                             file-name-coding-system
    6808           0 :                             default-file-name-coding-system
    6809           0 :                             'undecided))
    6810             :                 coding-no-eol
    6811             :                 val pos)
    6812           0 :             (when (and enable-multibyte-characters
    6813           0 :                        (not (memq (coding-system-base coding)
    6814           0 :                                   '(raw-text no-conversion))))
    6815             :               ;; If no coding system is specified or detection is
    6816             :               ;; requested, detect the coding.
    6817           0 :               (if (eq (coding-system-base coding) 'undecided)
    6818           0 :                   (setq coding (detect-coding-region beg (point) t)))
    6819           0 :               (if (not (eq (coding-system-base coding) 'undecided))
    6820           0 :                   (save-restriction
    6821           0 :                     (setq coding-no-eol
    6822           0 :                           (coding-system-change-eol-conversion coding 'unix))
    6823           0 :                     (narrow-to-region beg (point))
    6824           0 :                     (goto-char (point-min))
    6825           0 :                     (while (not (eobp))
    6826           0 :                       (setq pos (point)
    6827           0 :                             val (get-text-property (point) 'dired-filename))
    6828           0 :                       (goto-char (next-single-property-change
    6829           0 :                                   (point) 'dired-filename nil (point-max)))
    6830             :                       ;; Force no eol conversion on a file name, so
    6831             :                       ;; that CR is preserved.
    6832           0 :                       (decode-coding-region pos (point)
    6833           0 :                                             (if val coding-no-eol coding))
    6834           0 :                       (if val
    6835           0 :                           (put-text-property pos (point)
    6836           0 :                                              'dired-filename t)))))))
    6837             : 
    6838           0 :           (if full-directory-p
    6839             :               ;; Try to insert the amount of free space.
    6840           0 :               (save-excursion
    6841           0 :                 (goto-char beg)
    6842             :                 ;; First find the line to put it on.
    6843           0 :                 (when (re-search-forward "^ *\\(total\\)" nil t)
    6844           0 :                   (let ((available (get-free-disk-space ".")))
    6845           0 :                     (when available
    6846             :                       ;; Replace "total" with "used", to avoid confusion.
    6847           0 :                       (replace-match "total used in directory" nil nil nil 1)
    6848           0 :                       (end-of-line)
    6849          10 :                       (insert " available " available))))))))))
    6850             : 
    6851             : (defun insert-directory-adj-pos (pos error-lines)
    6852             :   "Convert `ls --dired' file name position value POS to a buffer position.
    6853             : File name position values returned in ls --dired output
    6854             : count only stdout; they don't count the error messages sent to stderr.
    6855             : So this function converts to them to real buffer positions.
    6856             : ERROR-LINES is a list of buffer positions of error message lines,
    6857             : of the form (START END)."
    6858           0 :   (while (and error-lines (< (caar error-lines) pos))
    6859           0 :     (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
    6860           0 :     (pop error-lines))
    6861           0 :   pos)
    6862             : 
    6863             : (defun insert-directory-safely (file switches
    6864             :                                      &optional wildcard full-directory-p)
    6865             :   "Insert directory listing for FILE, formatted according to SWITCHES.
    6866             : 
    6867             : Like `insert-directory', but if FILE does not exist, it inserts a
    6868             : message to that effect instead of signaling an error."
    6869           0 :   (if (file-exists-p file)
    6870           0 :       (insert-directory file switches wildcard full-directory-p)
    6871             :     ;; Simulate the message printed by `ls'.
    6872           0 :     (insert (format "%s: No such file or directory\n" file))))
    6873             : 
    6874             : (defcustom kill-emacs-query-functions nil
    6875             :   "Functions to call with no arguments to query about killing Emacs.
    6876             : If any of these functions returns nil, killing Emacs is canceled.
    6877             : `save-buffers-kill-emacs' calls these functions, but `kill-emacs',
    6878             : the low level primitive, does not.  See also `kill-emacs-hook'."
    6879             :   :type 'hook
    6880             :   :version "26.1"
    6881             :   :group 'convenience)
    6882             : 
    6883             : (defcustom confirm-kill-emacs nil
    6884             :   "How to ask for confirmation when leaving Emacs.
    6885             : If nil, the default, don't ask at all.  If the value is non-nil, it should
    6886             : be a predicate function; for example `yes-or-no-p'."
    6887             :   :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
    6888             :                  (const :tag "Ask with y-or-n-p" y-or-n-p)
    6889             :                  (const :tag "Don't confirm" nil)
    6890             :                  (function :tag "Predicate function"))
    6891             :   :group 'convenience
    6892             :   :version "21.1")
    6893             : 
    6894             : (defcustom confirm-kill-processes t
    6895             :   "Non-nil if Emacs should confirm killing processes on exit.
    6896             : If this variable is nil, the value of
    6897             : `process-query-on-exit-flag' is ignored.  Otherwise, if there are
    6898             : processes with a non-nil `process-query-on-exit-flag', Emacs will
    6899             : prompt the user before killing them."
    6900             :   :type 'boolean
    6901             :   :group 'convenience
    6902             :   :version "26.1")
    6903             : 
    6904             : (defun save-buffers-kill-emacs (&optional arg)
    6905             :   "Offer to save each buffer, then kill this Emacs process.
    6906             : With prefix ARG, silently save all file-visiting buffers without asking.
    6907             : If there are active processes where `process-query-on-exit-flag'
    6908             : returns non-nil and `confirm-kill-processes' is non-nil,
    6909             : asks whether processes should be killed.
    6910             : Runs the members of `kill-emacs-query-functions' in turn and stops
    6911             : if any returns nil.  If `confirm-kill-emacs' is non-nil, calls it."
    6912             :   (interactive "P")
    6913             :   ;; Don't use save-some-buffers-default-predicate, because we want
    6914             :   ;; to ask about all the buffers before killing Emacs.
    6915           0 :   (save-some-buffers arg t)
    6916           0 :   (let ((confirm confirm-kill-emacs))
    6917           0 :     (and
    6918           0 :      (or (not (memq t (mapcar (function
    6919           0 :                                (lambda (buf) (and (buffer-file-name buf)
    6920           0 :                                                   (buffer-modified-p buf))))
    6921           0 :                               (buffer-list))))
    6922           0 :          (progn (setq confirm nil)
    6923           0 :                 (yes-or-no-p "Modified buffers exist; exit anyway? ")))
    6924           0 :      (or (not (fboundp 'process-list))
    6925             :          ;; process-list is not defined on MSDOS.
    6926           0 :          (not confirm-kill-processes)
    6927           0 :          (let ((processes (process-list))
    6928             :                active)
    6929           0 :            (while processes
    6930           0 :              (and (memq (process-status (car processes)) '(run stop open listen))
    6931           0 :                   (process-query-on-exit-flag (car processes))
    6932           0 :                   (setq active t))
    6933           0 :              (setq processes (cdr processes)))
    6934           0 :            (or (not active)
    6935           0 :                (with-current-buffer-window
    6936           0 :                 (get-buffer-create "*Process List*") nil
    6937           0 :                 #'(lambda (window _value)
    6938           0 :                     (with-selected-window window
    6939           0 :                       (unwind-protect
    6940           0 :                           (progn
    6941           0 :                             (setq confirm nil)
    6942           0 :                             (yes-or-no-p "Active processes exist; kill them and exit anyway? "))
    6943           0 :                         (when (window-live-p window)
    6944           0 :                           (quit-restore-window window 'kill)))))
    6945           0 :                 (list-processes t)))))
    6946             :      ;; Query the user for other things, perhaps.
    6947           0 :      (run-hook-with-args-until-failure 'kill-emacs-query-functions)
    6948           0 :      (or (null confirm)
    6949           0 :          (funcall confirm "Really exit Emacs? "))
    6950           0 :      (kill-emacs))))
    6951             : 
    6952             : (defun save-buffers-kill-terminal (&optional arg)
    6953             :   "Offer to save each buffer, then kill the current connection.
    6954             : If the current frame has no client, kill Emacs itself using
    6955             : `save-buffers-kill-emacs'.
    6956             : 
    6957             : With prefix ARG, silently save all file-visiting buffers, then kill.
    6958             : 
    6959             : If emacsclient was started with a list of filenames to edit, then
    6960             : only these files will be asked to be saved."
    6961             :   (interactive "P")
    6962           0 :   (if (frame-parameter nil 'client)
    6963           0 :       (server-save-buffers-kill-terminal arg)
    6964           0 :     (save-buffers-kill-emacs arg)))
    6965             : 
    6966             : ;; We use /: as a prefix to "quote" a file name
    6967             : ;; so that magic file name handlers will not apply to it.
    6968             : 
    6969             : (setq file-name-handler-alist
    6970             :       (cons (cons (purecopy "\\`/:") 'file-name-non-special)
    6971             :             file-name-handler-alist))
    6972             : 
    6973             : ;; We depend on being the last handler on the list,
    6974             : ;; so that anything else which does need handling
    6975             : ;; has been handled already.
    6976             : ;; So it is safe for us to inhibit *all* magic file name handlers.
    6977             : 
    6978             : (defun file-name-non-special (operation &rest arguments)
    6979       17111 :   (let ((file-name-handler-alist nil)
    6980             :         (default-directory
    6981             :           ;; Some operations respect file name handlers in
    6982             :           ;; `default-directory'.  Because core function like
    6983             :           ;; `call-process' don't care about file name handlers in
    6984             :           ;; `default-directory', we here have to resolve the
    6985             :           ;; directory into a local one.  For `process-file',
    6986             :           ;; `start-file-process', and `shell-command', this fixes
    6987             :           ;; Bug#25949.
    6988       17111 :           (if (memq operation '(insert-directory process-file start-file-process
    6989       17111 :                                                  shell-command))
    6990           0 :               (directory-file-name
    6991           0 :                (expand-file-name
    6992           0 :                 (unhandled-file-name-directory default-directory)))
    6993       17111 :             default-directory))
    6994             :         ;; Get a list of the indices of the args which are file names.
    6995             :         (file-arg-indices
    6996       17111 :          (cdr (or (assq operation
    6997             :                         ;; The first six are special because they
    6998             :                         ;; return a file name.  We want to include the /:
    6999             :                         ;; in the return value.
    7000             :                         ;; So just avoid stripping it in the first place.
    7001             :                         '((expand-file-name . nil)
    7002             :                           (file-name-directory . nil)
    7003             :                           (file-name-as-directory . nil)
    7004             :                           (directory-file-name . nil)
    7005             :                           (file-name-sans-versions . nil)
    7006             :                           (find-backup-file-name . nil)
    7007             :                           ;; `identity' means just return the first arg
    7008             :                           ;; not stripped of its quoting.
    7009             :                           (substitute-in-file-name identity)
    7010             :                           ;; `add' means add "/:" to the result.
    7011             :                           (file-truename add 0)
    7012             :                           (insert-file-contents insert-file-contents 0)
    7013             :                           ;; `unquote-then-quote' means set buffer-file-name
    7014             :                           ;; temporarily to unquoted filename.
    7015             :                           (verify-visited-file-modtime unquote-then-quote)
    7016             :                           ;; List the arguments which are filenames.
    7017             :                           (file-name-completion 1)
    7018             :                           (file-name-all-completions 1)
    7019             :                           (write-region 2 5)
    7020             :                           (rename-file 0 1)
    7021             :                           (copy-file 0 1)
    7022             :                           (make-symbolic-link 0 1)
    7023       17111 :                           (add-name-to-file 0 1)))
    7024             :                   ;; For all other operations, treat the first argument only
    7025             :                   ;; as the file name.
    7026       17111 :                   '(nil 0))))
    7027             :         method
    7028             :         ;; Copy ARGUMENTS so we can replace elements in it.
    7029       17111 :         (arguments (copy-sequence arguments)))
    7030       17111 :     (if (symbolp (car file-arg-indices))
    7031       17111 :         (setq method (pop file-arg-indices)))
    7032             :     ;; Strip off the /: from the file names that have it.
    7033       17111 :     (save-match-data
    7034       31971 :       (while (consp file-arg-indices)
    7035       14860 :         (let ((pair (nthcdr (car file-arg-indices) arguments)))
    7036       14860 :           (and (car pair)
    7037       14860 :                (string-match "\\`/:" (car pair))
    7038       14860 :                (setcar pair
    7039       14860 :                        (if (= (length (car pair)) 2)
    7040             :                            "/"
    7041       14860 :                          (substring (car pair) 2)))))
    7042       17111 :         (setq file-arg-indices (cdr file-arg-indices))))
    7043       17111 :     (pcase method
    7044           0 :       (`identity (car arguments))
    7045           0 :       (`add (concat "/:" (apply operation arguments)))
    7046             :       (`insert-file-contents
    7047           0 :        (let ((visit (nth 1 arguments)))
    7048           0 :          (unwind-protect
    7049           0 :              (apply operation arguments)
    7050           0 :            (when (and visit buffer-file-name)
    7051           0 :              (setq buffer-file-name (concat "/:" buffer-file-name))))))
    7052             :       (`unquote-then-quote
    7053             :        ;; We can't use `cl-letf' with `(buffer-local-value)' here
    7054             :        ;; because it wouldn't work during bootstrapping.
    7055           0 :        (let ((buffer (current-buffer)))
    7056             :          ;; `unquote-then-quote' is only used for the
    7057             :          ;; `verify-visited-file-modtime' action, which takes a buffer
    7058             :          ;; as only optional argument.
    7059           0 :          (with-current-buffer (or (car arguments) buffer)
    7060           0 :            (let ((buffer-file-name (substring buffer-file-name 2)))
    7061             :              ;; Make sure to hide the temporary buffer change from the
    7062             :              ;; underlying operation.
    7063           0 :              (with-current-buffer buffer
    7064           0 :                (apply operation arguments))))))
    7065             :       (_
    7066       17111 :        (apply operation arguments)))))
    7067             : 
    7068             : (defsubst file-name-quoted-p (name)
    7069             :   "Whether NAME is quoted with prefix \"/:\".
    7070             : If NAME is a remote file name, check the local part of NAME."
    7071       92484 :   (string-prefix-p "/:" (file-local-name name)))
    7072             : 
    7073             : (defsubst file-name-quote (name)
    7074             :   "Add the quotation prefix \"/:\" to file NAME.
    7075             : If NAME is a remote file name, the local part of NAME is quoted.
    7076             : If NAME is already a quoted file name, NAME is returned unchanged."
    7077        1742 :   (if (file-name-quoted-p name)
    7078           0 :       name
    7079        1742 :     (concat (file-remote-p name) "/:" (file-local-name name))))
    7080             : 
    7081             : (defsubst file-name-unquote (name)
    7082             :   "Remove quotation prefix \"/:\" from file NAME, if any.
    7083             : If NAME is a remote file name, the local part of NAME is unquoted."
    7084       65715 :   (let ((localname (file-local-name name)))
    7085       65715 :     (when (file-name-quoted-p localname)
    7086        4328 :       (setq
    7087       65715 :        localname (if (= (length localname) 2) "/" (substring localname 2))))
    7088       65715 :     (concat (file-remote-p name) localname)))
    7089             : 
    7090             : ;; Symbolic modes and read-file-modes.
    7091             : 
    7092             : (defun file-modes-char-to-who (char)
    7093             :   "Convert CHAR to a numeric bit-mask for extracting mode bits.
    7094             : CHAR is in [ugoa] and represents the category of users (Owner, Group,
    7095             : Others, or All) for whom to produce the mask.
    7096             : The bit-mask that is returned extracts from mode bits the access rights
    7097             : for the specified category of users."
    7098           0 :   (cond ((= char ?u) #o4700)
    7099           0 :         ((= char ?g) #o2070)
    7100           0 :         ((= char ?o) #o1007)
    7101           0 :         ((= char ?a) #o7777)
    7102           0 :         (t (error "%c: bad `who' character" char))))
    7103             : 
    7104             : (defun file-modes-char-to-right (char &optional from)
    7105             :   "Convert CHAR to a numeric value of mode bits.
    7106             : CHAR is in [rwxXstugo] and represents symbolic access permissions.
    7107             : If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
    7108           0 :   (or from (setq from 0))
    7109           0 :   (cond ((= char ?r) #o0444)
    7110           0 :         ((= char ?w) #o0222)
    7111           0 :         ((= char ?x) #o0111)
    7112           0 :         ((= char ?s) #o6000)
    7113           0 :         ((= char ?t) #o1000)
    7114             :         ;; Rights relative to the previous file modes.
    7115           0 :         ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
    7116           0 :         ((= char ?u) (let ((uright (logand #o4700 from)))
    7117           0 :                        (+ uright (/ uright #o10) (/ uright #o100))))
    7118           0 :         ((= char ?g) (let ((gright (logand #o2070 from)))
    7119           0 :                        (+ gright (/ gright #o10) (* gright #o10))))
    7120           0 :         ((= char ?o) (let ((oright (logand #o1007 from)))
    7121           0 :                        (+ oright (* oright #o10) (* oright #o100))))
    7122           0 :         (t (error "%c: bad right character" char))))
    7123             : 
    7124             : (defun file-modes-rights-to-number (rights who-mask &optional from)
    7125             :   "Convert a symbolic mode string specification to an equivalent number.
    7126             : RIGHTS is the symbolic mode spec, it should match \"([+=-][rwxXstugo]*)+\".
    7127             : WHO-MASK is the bit-mask specifying the category of users to which to
    7128             : apply the access permissions.  See `file-modes-char-to-who'.
    7129             : FROM (or 0 if nil) gives the mode bits on which to base permissions if
    7130             : RIGHTS request to add, remove, or set permissions based on existing ones,
    7131             : as in \"og+rX-w\"."
    7132           0 :   (let* ((num-rights (or from 0))
    7133           0 :          (list-rights (string-to-list rights))
    7134           0 :          (op (pop list-rights)))
    7135           0 :     (while (memq op '(?+ ?- ?=))
    7136           0 :       (let ((num-right 0)
    7137             :             char-right)
    7138           0 :         (while (memq (setq char-right (pop list-rights))
    7139           0 :                      '(?r ?w ?x ?X ?s ?t ?u ?g ?o))
    7140           0 :           (setq num-right
    7141           0 :                 (logior num-right
    7142           0 :                         (file-modes-char-to-right char-right num-rights))))
    7143           0 :         (setq num-right (logand who-mask num-right)
    7144             :               num-rights
    7145           0 :               (cond ((= op ?+) (logior num-rights num-right))
    7146           0 :                     ((= op ?-) (logand num-rights (lognot num-right)))
    7147           0 :                     (t (logior (logand num-rights (lognot who-mask)) num-right)))
    7148           0 :               op char-right)))
    7149           0 :     num-rights))
    7150             : 
    7151             : (defun file-modes-symbolic-to-number (modes &optional from)
    7152             :   "Convert symbolic file modes to numeric file modes.
    7153             : MODES is the string to convert, it should match
    7154             : \"[ugoa]*([+-=][rwxXstugo]*)+,...\".
    7155             : See Info node `(coreutils)File permissions' for more information on this
    7156             : notation.
    7157             : FROM (or 0 if nil) gives the mode bits on which to base permissions if
    7158             : MODES request to add, remove, or set permissions based on existing ones,
    7159             : as in \"og+rX-w\"."
    7160           0 :   (save-match-data
    7161           0 :     (let ((case-fold-search nil)
    7162           0 :           (num-modes (or from 0)))
    7163           0 :       (while (/= (string-to-char modes) 0)
    7164           0 :         (if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]*\\)+\\(,\\|\\)" modes)
    7165           0 :             (let ((num-who (apply 'logior 0
    7166           0 :                                   (mapcar 'file-modes-char-to-who
    7167           0 :                                           (match-string 1 modes)))))
    7168           0 :               (when (= num-who 0)
    7169           0 :                 (setq num-who (logior #o7000 (default-file-modes))))
    7170           0 :               (setq num-modes
    7171           0 :                     (file-modes-rights-to-number (substring modes (match-end 1))
    7172           0 :                                                  num-who num-modes)
    7173           0 :                     modes (substring modes (match-end 3))))
    7174           0 :           (error "Parse error in modes near `%s'" (substring modes 0))))
    7175           0 :       num-modes)))
    7176             : 
    7177             : (defun read-file-modes (&optional prompt orig-file)
    7178             :   "Read file modes in octal or symbolic notation and return its numeric value.
    7179             : PROMPT is used as the prompt, default to \"File modes (octal or symbolic): \".
    7180             : ORIG-FILE is the name of a file on whose mode bits to base returned
    7181             : permissions if what user types requests to add, remove, or set permissions
    7182             : based on existing mode bits, as in \"og+rX-w\"."
    7183           0 :   (let* ((modes (or (if orig-file (file-modes orig-file) 0)
    7184           0 :                     (error "File not found")))
    7185           0 :          (modestr (and (stringp orig-file)
    7186           0 :                        (nth 8 (file-attributes orig-file))))
    7187             :          (default
    7188           0 :            (and (stringp modestr)
    7189           0 :                 (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
    7190           0 :                 (replace-regexp-in-string
    7191             :                  "-" ""
    7192           0 :                  (format "u=%s,g=%s,o=%s"
    7193           0 :                          (match-string 1 modestr)
    7194           0 :                          (match-string 2 modestr)
    7195           0 :                          (match-string 3 modestr)))))
    7196           0 :          (value (read-string (or prompt "File modes (octal or symbolic): ")
    7197           0 :                              nil nil default)))
    7198           0 :     (save-match-data
    7199           0 :       (if (string-match "^[0-7]+" value)
    7200           0 :           (string-to-number value 8)
    7201           0 :         (file-modes-symbolic-to-number value modes)))))
    7202             : 
    7203             : (define-obsolete-variable-alias 'cache-long-line-scans
    7204             :   'cache-long-scans "24.4")
    7205             : 
    7206             : ;; Trashcan handling.
    7207             : (defcustom trash-directory nil
    7208             :   "Directory for `move-file-to-trash' to move files and directories to.
    7209             : This directory is only used when the function `system-move-file-to-trash'
    7210             : is not defined.
    7211             : Relative paths are interpreted relative to `default-directory'.
    7212             : If the value is nil, Emacs uses a freedesktop.org-style trashcan."
    7213             :   :type  '(choice (const nil) directory)
    7214             :   :group 'auto-save
    7215             :   :version "23.2")
    7216             : 
    7217             : (defvar trash--hexify-table)
    7218             : 
    7219             : (declare-function system-move-file-to-trash "w32fns.c" (filename))
    7220             : 
    7221             : (defun move-file-to-trash (filename)
    7222             :   "Move the file (or directory) named FILENAME to the trash.
    7223             : When `delete-by-moving-to-trash' is non-nil, this function is
    7224             : called by `delete-file' and `delete-directory' instead of
    7225             : deleting files outright.
    7226             : 
    7227             : If the function `system-move-file-to-trash' is defined, call it
    7228             :  with FILENAME as an argument.
    7229             : Otherwise, if `trash-directory' is non-nil, move FILENAME to that
    7230             :  directory.
    7231             : Otherwise, trash FILENAME using the freedesktop.org conventions,
    7232             :  like the GNOME, KDE and XFCE desktop environments.  Emacs only
    7233             :  moves files to \"home trash\", ignoring per-volume trashcans."
    7234             :   (interactive "fMove file to trash: ")
    7235           0 :   (cond (trash-directory
    7236             :          ;; If `trash-directory' is non-nil, move the file there.
    7237           0 :          (let* ((trash-dir   (expand-file-name trash-directory))
    7238           0 :                 (fn          (directory-file-name (expand-file-name filename)))
    7239           0 :                 (new-fn      (expand-file-name (file-name-nondirectory fn)
    7240           0 :                                                trash-dir)))
    7241             :            ;; We can't trash a parent directory of trash-directory.
    7242           0 :            (if (string-prefix-p fn trash-dir)
    7243           0 :                (error "Trash directory `%s' is a subdirectory of `%s'"
    7244           0 :                       trash-dir filename))
    7245           0 :            (unless (file-directory-p trash-dir)
    7246           0 :              (make-directory trash-dir t))
    7247             :            ;; Ensure that the trashed file-name is unique.
    7248           0 :            (if (file-exists-p new-fn)
    7249           0 :                (let ((version-control t)
    7250             :                      (backup-directory-alist nil))
    7251           0 :                  (setq new-fn (car (find-backup-file-name new-fn)))))
    7252           0 :            (let (delete-by-moving-to-trash)
    7253           0 :              (rename-file fn new-fn))))
    7254             :         ;; If `system-move-file-to-trash' is defined, use it.
    7255           0 :         ((fboundp 'system-move-file-to-trash)
    7256           0 :          (system-move-file-to-trash filename))
    7257             :         ;; Otherwise, use the freedesktop.org method, as specified at
    7258             :         ;; http://freedesktop.org/wiki/Specifications/trash-spec
    7259             :         (t
    7260           0 :          (let* ((xdg-data-dir
    7261           0 :                  (directory-file-name
    7262           0 :                   (expand-file-name "Trash"
    7263           0 :                                     (or (getenv "XDG_DATA_HOME")
    7264           0 :                                         "~/.local/share"))))
    7265           0 :                 (trash-files-dir (expand-file-name "files" xdg-data-dir))
    7266           0 :                 (trash-info-dir (expand-file-name "info" xdg-data-dir))
    7267           0 :                 (fn (directory-file-name (expand-file-name filename))))
    7268             : 
    7269             :            ;; Check if we have permissions to delete.
    7270           0 :            (unless (file-writable-p (directory-file-name
    7271           0 :                                      (file-name-directory fn)))
    7272           0 :              (error "Cannot move %s to trash: Permission denied" filename))
    7273             :            ;; The trashed file cannot be the trash dir or its parent.
    7274           0 :            (if (string-prefix-p fn trash-files-dir)
    7275           0 :                (error "The trash directory %s is a subdirectory of %s"
    7276           0 :                       trash-files-dir filename))
    7277           0 :            (if (string-prefix-p fn trash-info-dir)
    7278           0 :                (error "The trash directory %s is a subdirectory of %s"
    7279           0 :                       trash-info-dir filename))
    7280             : 
    7281             :            ;; Ensure that the trash directory exists; otherwise, create it.
    7282           0 :            (with-file-modes #o700
    7283           0 :              (unless (file-exists-p trash-files-dir)
    7284           0 :                (make-directory trash-files-dir t))
    7285           0 :              (unless (file-exists-p trash-info-dir)
    7286           0 :                (make-directory trash-info-dir t)))
    7287             : 
    7288             :            ;; Try to move to trash with .trashinfo undo information
    7289           0 :            (save-excursion
    7290           0 :              (with-temp-buffer
    7291           0 :                (set-buffer-file-coding-system 'utf-8-unix)
    7292           0 :                (insert "[Trash Info]\nPath=")
    7293             :                ;; Perform url-encoding on FN.  For compatibility with
    7294             :                ;; other programs (e.g. XFCE Thunar), allow literal "/"
    7295             :                ;; for path separators.
    7296           0 :                (unless (boundp 'trash--hexify-table)
    7297           0 :                  (setq trash--hexify-table (make-vector 256 nil))
    7298           0 :                  (let ((unreserved-chars
    7299           0 :                         (list ?/ ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
    7300             :                               ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A
    7301             :                               ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O
    7302             :                               ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2
    7303             :                               ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?_ ?. ?! ?~ ?* ?'
    7304           0 :                               ?\( ?\))))
    7305           0 :                    (dotimes (byte 256)
    7306           0 :                      (aset trash--hexify-table byte
    7307           0 :                            (if (memq byte unreserved-chars)
    7308           0 :                                (char-to-string byte)
    7309           0 :                              (format "%%%02x" byte))))))
    7310           0 :                (mapc (lambda (byte)
    7311           0 :                        (insert (aref trash--hexify-table byte)))
    7312           0 :                      (if (multibyte-string-p fn)
    7313           0 :                          (encode-coding-string fn 'utf-8)
    7314           0 :                        fn))
    7315           0 :                (insert "\nDeletionDate="
    7316           0 :                        (format-time-string "%Y-%m-%dT%T")
    7317           0 :                        "\n")
    7318             : 
    7319             :                ;; Make a .trashinfo file.  Use O_EXCL, as per trash-spec 1.0.
    7320           0 :                (let* ((files-base (file-name-nondirectory fn))
    7321           0 :                       (info-fn (expand-file-name
    7322           0 :                                 (concat files-base ".trashinfo")
    7323           0 :                                 trash-info-dir)))
    7324           0 :                  (condition-case nil
    7325           0 :                      (write-region nil nil info-fn nil 'quiet info-fn 'excl)
    7326             :                    (file-already-exists
    7327             :                     ;; Uniquify new-fn.  Some file managers do not
    7328             :                     ;; like Emacs-style backup file names.  E.g.:
    7329             :                     ;; https://bugs.kde.org/170956
    7330           0 :                     (setq info-fn (make-temp-file
    7331           0 :                                    (expand-file-name files-base trash-info-dir)
    7332           0 :                                    nil ".trashinfo"))
    7333           0 :                     (setq files-base (file-name-nondirectory info-fn))
    7334           0 :                     (write-region nil nil info-fn nil 'quiet info-fn)))
    7335             :                  ;; Finally, try to move the file to the trashcan.
    7336           0 :                  (let ((delete-by-moving-to-trash nil)
    7337           0 :                        (new-fn (expand-file-name files-base trash-files-dir)))
    7338           0 :                    (rename-file fn new-fn)))))))))
    7339             : 
    7340             : (defsubst file-attribute-type (attributes)
    7341             :   "The type field in ATTRIBUTES returned by `file-attributes'.
    7342             : The value is either t for directory, string (name linked to) for
    7343             : symbolic link, or nil."
    7344        1402 :   (nth 0 attributes))
    7345             : 
    7346             : (defsubst file-attribute-link-number (attributes)
    7347             :   "Return the number of links in ATTRIBUTES returned by `file-attributes'."
    7348           0 :   (nth 1 attributes))
    7349             : 
    7350             : (defsubst file-attribute-user-id (attributes)
    7351             :   "The UID field in ATTRIBUTES returned by `file-attributes'.
    7352             : This is either a string or a number.  If a string value cannot be
    7353             : looked up, a numeric value, either an integer or a float, is
    7354             : returned."
    7355         786 :   (nth 2 attributes))
    7356             : 
    7357             : (defsubst file-attribute-group-id (attributes)
    7358             :   "The GID field in ATTRIBUTES returned by `file-attributes'.
    7359             : This is either a string or a number.  If a string value cannot be
    7360             : looked up, a numeric value, either an integer or a float, is
    7361             : returned."
    7362         411 :   (nth 3 attributes))
    7363             : 
    7364             : (defsubst file-attribute-access-time (attributes)
    7365             :   "The last access time in ATTRIBUTES returned by `file-attributes'.
    7366             : This a list of integers (HIGH LOW USEC PSEC) in the same style
    7367             : as (current-time)."
    7368           0 :   (nth 4 attributes))
    7369             : 
    7370             : (defsubst file-attribute-modification-time (attributes)
    7371             :   "The modification time in ATTRIBUTES returned by `file-attributes'.
    7372             : This is the time of the last change to the file's contents, and
    7373             : is a list of integers (HIGH LOW USEC PSEC) in the same style
    7374             : as (current-time)."
    7375          28 :   (nth 5 attributes))
    7376             : 
    7377             : (defsubst file-attribute-status-change-time (attributes)
    7378             :   "The status modification time in ATTRIBUTES returned by `file-attributes'.
    7379             : This is the time of last change to the file's attributes: owner
    7380             : and group, access mode bits, etc, and is a list of integers (HIGH
    7381             : LOW USEC PSEC) in the same style as (current-time)."
    7382           0 :   (nth 6 attributes))
    7383             : 
    7384             : (defsubst file-attribute-size (attributes)
    7385             :   "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
    7386             : This is a floating point number if the size is too large for an integer."
    7387        1031 :   (nth 7 attributes))
    7388             : 
    7389             : (defsubst file-attribute-modes (attributes)
    7390             :   "The file modes in ATTRIBUTES returned by `file-attributes'.
    7391             : This is a string of ten letters or dashes as in ls -l."
    7392        1137 :   (nth 8 attributes))
    7393             : 
    7394             : (defsubst file-attribute-inode-number (attributes)
    7395             :   "The inode number in ATTRIBUTES returned by `file-attributes'.
    7396             : If it is larger than what an Emacs integer can hold, this is of
    7397             : the form (HIGH . LOW): first the high bits, then the low 16 bits.
    7398             : If even HIGH is too large for an Emacs integer, this is instead
    7399             : of the form (HIGH MIDDLE . LOW): first the high bits, then the
    7400             : middle 24 bits, and finally the low 16 bits."
    7401           0 :   (nth 10 attributes))
    7402             : 
    7403             : (defsubst file-attribute-device-number (attributes)
    7404             :   "The file system device number in ATTRIBUTES returned by `file-attributes'.
    7405             : If it is larger than what an Emacs integer can hold, this is of
    7406             : the form (HIGH . LOW): first the high bits, then the low 16 bits.
    7407             : If even HIGH is too large for an Emacs integer, this is instead
    7408             : of the form (HIGH MIDDLE . LOW): first the high bits, then the
    7409             : middle 24 bits, and finally the low 16 bits."
    7410           0 :   (nth 11 attributes))
    7411             : 
    7412             : (defun file-attribute-collect (attributes &rest attr-names)
    7413             :   "Return a sublist of ATTRIBUTES returned by `file-attributes'.
    7414             : ATTR-NAMES are symbols with the selected attribute names.
    7415             : 
    7416             : Valid attribute names are: type, link-number, user-id, group-id,
    7417             : access-time, modification-time, status-change-time, size, modes,
    7418             : inode-number and device-number."
    7419           0 :   (let ((all '(type link-number user-id group-id access-time
    7420             :                modification-time status-change-time
    7421             :                size modes inode-number device-number))
    7422             :         result)
    7423           0 :     (while attr-names
    7424           0 :       (let ((attr (pop attr-names)))
    7425           0 :         (if (memq attr all)
    7426           0 :             (push (funcall
    7427           0 :                    (intern (format "file-attribute-%s" (symbol-name attr)))
    7428           0 :                    attributes)
    7429           0 :                   result)
    7430           0 :           (error "Wrong attribute name '%S'" attr))))
    7431           0 :     (nreverse result)))
    7432             : 
    7433             : (define-key ctl-x-map "\C-f" 'find-file)
    7434             : (define-key ctl-x-map "\C-r" 'find-file-read-only)
    7435             : (define-key ctl-x-map "\C-v" 'find-alternate-file)
    7436             : (define-key ctl-x-map "\C-s" 'save-buffer)
    7437             : (define-key ctl-x-map "s" 'save-some-buffers)
    7438             : (define-key ctl-x-map "\C-w" 'write-file)
    7439             : (define-key ctl-x-map "i" 'insert-file)
    7440             : (define-key esc-map "~" 'not-modified)
    7441             : (define-key ctl-x-map "\C-d" 'list-directory)
    7442             : (define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal)
    7443             : (define-key ctl-x-map "\C-q" 'read-only-mode)
    7444             : 
    7445             : (define-key ctl-x-4-map "f" 'find-file-other-window)
    7446             : (define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
    7447             : (define-key ctl-x-4-map "\C-f" 'find-file-other-window)
    7448             : (define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
    7449             : (define-key ctl-x-4-map "\C-o" 'display-buffer)
    7450             : 
    7451             : (define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
    7452             : (define-key ctl-x-5-map "f" 'find-file-other-frame)
    7453             : (define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
    7454             : (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
    7455             : (define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame)
    7456             : 
    7457             : ;;; files.el ends here

Generated by: LCOV version 1.12