"*If t, delete excess backup versions silently.
If nil, ask confirmation. Any other value prevents any trimming."
:type '(choice (const :tag "Delete" t)
- (const :tag "Ask" nil)
- (sexp :tag "Leave" :format "%t\n" other))
+ (const :tag "Ask" nil)
+ (sexp :tag "Leave" :format "%t\n" other))
:group 'backup)
(defcustom kept-old-versions 2
:type 'boolean
:group 'find-file)
+;;; Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
+(defcustom find-directory-functions '(cvs-dired-noselect dired-noselect)
+ "*List of functions to try in sequence to visit a directory.
+Each function is called with the directory name as the sole argument
+and should return either a buffer or nil."
+ :type '(hook :options (cvs-dired-noselect dired-noselect))
+ :group 'find-file)
+;;; End Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
+
;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-hooks 'permanent-local t)
(defvar find-file-not-found-hooks nil
(let ((name (copy-sequence filename))
(start 0))
;; leave ':' if part of drive specifier
- (if (and (> (length name) 1)
- (eq (aref name 1) ?:))
+ (if (and (> (length name) 1)
+ (eq (aref name 1) ?:))
(setq start 2))
;; destructively replace invalid filename characters with !
(while (string-match "[?*:<>|\"\000-\037]" name start)
(setq dir (file-truename dir)))
(setq dir (abbreviate-file-name (expand-file-name dir)))
(cond ((not (file-directory-p dir))
- (error "%s is not a directory" dir))
+ (error "%s is not a directory" dir))
;; this breaks ange-ftp, which doesn't (can't?) overload `file-executable-p'.
- ;;((not (file-executable-p dir))
- ;; (error "Cannot cd to %s: Permission denied" dir))
- (t
- (setq default-directory dir))))
+ ;;((not (file-executable-p dir))
+ ;; (error "Cannot cd to %s: Permission denied" dir))
+ (t
+ (setq default-directory dir))))
+
+(defun file-name-join (dirname basename)
+ "Return the filename defined by the concatenation of DIRNAME and BASENAME.
+Only one path component separator will ever be used in the result formation.
+
+Can be use to reassemble a file name separated by `file-name-directory'
+`file-name-nondirectory' and `file-dirname' `file-basename'."
+ (when (and (or (null dirname) (equal 0 (length dirname)))
+ (or (null basename) (equal 0 (length basename))))
+ (error "Both dirname (%S) and basename (%S) empty." dirname basename))
+ (let* ((dir (if (and dirname (> (length dirname) 0))
+ (if (equal "/" (substring dirname -1))
+ (substring dirname 0 -1)
+ dirname)
+ "."))
+ (base (if (and basename (> (length basename) 0))
+ (if (equal "/" (substring basename 0 1))
+ (substring basename 1)
+ basename)
+ (if (equal dir ".") "." ""))))
+ (if (and (equal 0 (length base))
+ (> (length dir) 0))
+ (concat dir)
+ (concat dir "/" base))))
(defun cd (dir)
"Make DIR become the current buffer's default directory.
(setq cd-path (or trypath (list "./")))))
(or (catch 'found
(mapcar #'(lambda (x)
- (let ((f (expand-file-name (concat x dir))))
+ (let ((f (expand-file-name (concat x dir))))
(if (file-directory-p f)
(progn
- (cd-absolute f)
- (throw 'found t)))))
+ (cd-absolute f)
+ (throw 'found t)))))
cd-path)
nil)
;; jwz: give a better error message to those of us with the
(make-frame-visible frame)
buffer))
-(defun find-file (filename &optional codesys)
+;;; Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
+(defun switch-to-next-buffer (&optional n)
+ "Switch to the next-most-recent buffer.
+This essentially rotates the buffer list forward.
+N (interactively, the prefix arg) specifies how many times to rotate
+forward, and defaults to 1. Buffers whose name begins with a space
+\(i.e. \"invisible\" buffers) are ignored."
+ ;; Here is a different interactive spec. Look up the function
+ ;; `interactive' (i.e. `C-h f interactive') to understand how this
+ ;; all works.
+ (interactive "p")
+ (dotimes (n (or n 1))
+ (loop
+ do (bury-buffer (car (buffer-list)))
+ while (funcall buffers-tab-omit-function (car (buffer-list))))
+ (switch-to-buffer (car (buffer-list)))))
+
+(defun switch-to-previous-buffer (&optional n)
+ "Switch to the previously most-recent buffer.
+This essentially rotates the buffer list backward.
+N (interactively, the prefix arg) specifies how many times to rotate
+backward, and defaults to 1. Buffers whose name begins with a space
+\(i.e. \"invisible\" buffers) are ignored."
+ (interactive "p")
+ (dotimes (n (or n 1))
+ (loop
+ do (switch-to-buffer (car (last (buffer-list))))
+ while (funcall buffers-tab-omit-function (car (buffer-list))))))
+
+;;; FIXME: Could this looping be done with #'mapfam in a nicer way.
+(defun switch-to-next-buffer-in-group (&optional n)
+ "Switch to the next-most-recent buffer in the current group.
+This essentially rotates the buffer list forward.
+N (interactively, the prefix arg) specifies how many times to rotate
+forward, and defaults to 1. Buffers whose name begins with a space
+\(i.e. \"invisible\" buffers) are ignored."
+ (interactive "p")
+ (dotimes (n (or n 1))
+ (let ((curbuf (car (buffer-list))))
+ (loop
+ do (bury-buffer (car (buffer-list)))
+ while (or (funcall buffers-tab-omit-function (car (buffer-list)))
+ (not (mapcar
+ #'(lambda (f)
+ (funcall f curbuf (car (buffer-list))))
+ buffers-tab-filter-functions)))))
+ (switch-to-buffer (car (buffer-list)))))
+
+;;; FIXME: Could this looping be done with #'mapfam in a nicer way.
+(defun switch-to-previous-buffer-in-group (&optional n)
+ "Switch to the previously most-recent buffer in the current group.
+This essentially rotates the buffer list backward.
+N (interactively, the prefix arg) specifies how many times to rotate
+backward, and defaults to 1. Buffers whose name begins with a space
+\(i.e. \"invisible\" buffers) are ignored."
+ (interactive "p")
+ (dotimes (n (or n 1))
+ (let ((curbuf (car (buffer-list))))
+ (loop
+ do (switch-to-buffer (car (last (buffer-list))))
+ while (or (funcall buffers-tab-omit-function (car (buffer-list)))
+ (not (mapcar
+ #'(lambda (f)
+ (funcall f curbuf (car (buffer-list))))
+ buffers-tab-filter-functions)))))))
+
+(defmacro find-file-create-switch-thunk (switch-function)
+ "Mark buffer modified if needed, then call SWITCH-FUNCTION.
+
+The buffer will be marked modified if the file associated with the buffer
+does not exist. This means that \\[find-file] on a non-existent file will
+create a modified buffer, making \\[save-buffer] sufficient to create the
+file.
+
+SWITCH-FUNCTION should be `switch-to-buffer' or a related function. This
+function (that is, `find-file-create-switch-thunk') is implemented as a macro
+because we don't have built-in lexical scope, a closure created with
+`lexical-let' will always run as interpreted code. Though functions created
+by this macro are unlikely to be called in performance-critical contexts.
+
+This function may be called from functions related to `find-file', as well
+as `find-file' itself."
+ `(function
+ (lambda (buffer)
+ (unless (and (buffer-file-name buffer)
+ (file-exists-p (buffer-file-name buffer)))
+ ;; XEmacs: nonexistent file--qualifies as a modification to the
+ ;; buffer.
+ (set-buffer-modified-p t buffer))
+ (,switch-function buffer))))
+
+(defun find-file (filename &optional codesys wildcards)
"Edit file FILENAME.
-Switch to a buffer visiting file FILENAME,
-creating one if none already exists.
-Under XEmacs/Mule, optional second argument specifies the
-coding system to use when decoding the file. Interactively,
-with a prefix argument, you will be prompted for the coding system."
- (interactive "FFind file: \nZCoding system: ")
- (if codesys
- (let ((coding-system-for-read
- (get-coding-system codesys)))
- (switch-to-buffer (find-file-noselect filename)))
- (switch-to-buffer (find-file-noselect filename))))
-
-(defun find-file-other-window (filename &optional codesys)
+Switch to a buffer visiting file FILENAME, creating one if none already
+exists. Optional second argument specifies the coding system to use when
+decoding the file. Interactively, with a prefix argument, you will be
+prompted for the coding system.
+
+If you do not explicitly specify a coding system, the coding system
+is determined as follows:
+
+1. `coding-system-for-read', if non-nil. (This is used by Lisp programs to
+ temporarily set an overriding coding system and should almost never
+ apply here in `find-file'.)
+2. The result of `insert-file-contents-pre-hook', if non-nil. (This is a
+ complex interface for handling special cases.)
+3. The matching value for this filename from `file-coding-system-alist',
+ if any. (This lets you specify the coding system to be used for
+ files with particular extensions, names, etc.)
+4. `buffer-file-coding-system-for-read', if non-nil. (This is the global
+ default -- normally `undecided', so the built-in auto-detection
+ mechanism can do its thing.)
+5. The coding system 'raw-text.
+
+See `insert-file-contents' for more details about how the process of
+determining the coding system works.
+
+Interactively, or if WILDCARDS is non-nil in a call from Lisp,
+expand wildcards (if any) and visit multiple files. Wildcard expansion
+can be suppressed by setting `find-file-wildcards' to `nil'."
+ (interactive (list (read-file-name "Find file: ")
+ (and current-prefix-arg
+ (read-coding-system "Coding system: "))
+ t))
+ (and codesys (setq codesys (check-coding-system codesys)))
+ (let* ((coding-system-for-read (or codesys coding-system-for-read))
+ (value (find-file-noselect filename nil nil wildcards))
+ (thunk (find-file-create-switch-thunk switch-to-buffer)))
+ (if (listp value)
+ (mapcar thunk (nreverse value))
+ (funcall thunk value))))
+
+(defun find-file-other-window (filename &optional codesys wildcards)
"Edit file FILENAME, in another window.
-May create a new window, or reuse an existing one.
-See the function `display-buffer'.
-Under XEmacs/Mule, optional second argument specifies the
-coding system to use when decoding the file. Interactively,
-with a prefix argument, you will be prompted for the coding system."
- (interactive "FFind file in other window: \nZCoding system: ")
- (if codesys
- (let ((coding-system-for-read
- (get-coding-system codesys)))
- (switch-to-buffer-other-window (find-file-noselect filename)))
- (switch-to-buffer-other-window (find-file-noselect filename))))
-
-(defun find-file-other-frame (filename &optional codesys)
+May create a new window, or reuse an existing one. See the function
+`display-buffer'. Optional second argument specifies the coding system to
+use when decoding the file. Interactively, with a prefix argument, you
+will be prompted for the coding system."
+ (interactive (list (read-file-name "Find file in other window: ")
+ (and current-prefix-arg
+ (read-coding-system "Coding system: "))
+ t))
+ (and codesys (setq codesys (check-coding-system codesys)))
+ (let* ((coding-system-for-read (or codesys coding-system-for-read))
+ (value (find-file-noselect filename nil nil wildcards))
+ (list (and (listp value) (nreverse value)))
+ (other-window-thunk (find-file-create-switch-thunk
+ switch-to-buffer-other-window)))
+ (if list
+ (cons
+ (funcall other-window-thunk (car list))
+ (mapcar (find-file-create-switch-thunk switch-to-buffer) (cdr list)))
+ (funcall other-window-thunk value))))
+
+(defun find-file-other-frame (filename &optional codesys wildcards)
"Edit file FILENAME, in a newly-created frame.
-Under XEmacs/Mule, optional second argument specifies the
-coding system to use when decoding the file. Interactively,
-with a prefix argument, you will be prompted for the coding system."
- (interactive "FFind file in other frame: \nZCoding system: ")
- (if codesys
- (let ((coding-system-for-read
- (get-coding-system codesys)))
- (switch-to-buffer-other-frame (find-file-noselect filename)))
- (switch-to-buffer-other-frame (find-file-noselect filename))))
-
-(defun find-file-read-only (filename &optional codesys)
+Optional second argument specifies the coding system to use when decoding
+the file. Interactively, with a prefix argument, you will be prompted for
+the coding system."
+ (interactive (list (read-file-name "Find file in other frame: ")
+ (and current-prefix-arg
+ (read-coding-system "Coding system: "))
+ t))
+ (and codesys (setq codesys (check-coding-system codesys)))
+ (let* ((coding-system-for-read (or codesys coding-system-for-read))
+ (value (find-file-noselect filename nil nil wildcards))
+ (list (and (listp value) (nreverse value)))
+ (other-frame-thunk (find-file-create-switch-thunk
+ switch-to-buffer-other-frame)))
+ (if list
+ (cons
+ (funcall other-frame-thunk (car list))
+ (mapcar (find-file-create-switch-thunk switch-to-buffer) (cdr list)))
+ (funcall other-frame-thunk value))))
+
+;; No need to keep this macro around in the dumped executable.
+(unintern 'find-file-create-switch-thunk)
+
+(defun find-file-read-only (filename &optional codesys wildcards)
"Edit file FILENAME but don't allow changes.
Like \\[find-file] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing.
-Under XEmacs/Mule, optional second argument specifies the
-coding system to use when decoding the file. Interactively,
-with a prefix argument, you will be prompted for the coding system."
- (interactive "fFind file read-only: \nZCoding system: ")
- (if codesys
- (let ((coding-system-for-read
- (get-coding-system codesys)))
- (find-file filename))
- (find-file filename))
- (setq buffer-read-only t)
- (current-buffer))
-
-(defun find-file-read-only-other-window (filename &optional codesys)
+Optional second argument specifies the coding system to use when decoding
+the file. Interactively, with a prefix argument, you will be prompted for
+the coding system."
+ (interactive (list (read-file-name "Find file read-only: ")
+ (and current-prefix-arg
+ (read-coding-system "Coding system: "))
+ t))
+ (let ((value (find-file filename codesys wildcards)))
+ (mapc #'(lambda (buffer)
+ (set-symbol-value-in-buffer 'buffer-read-only t buffer))
+ (if (listp value) value (list value)))
+ value))
+
+(defun find-file-read-only-other-window (filename &optional codesys wildcards)
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing.
-Under XEmacs/Mule, optional second argument specifies the
-coding system to use when decoding the file. Interactively,
-with a prefix argument, you will be prompted for the coding system."
- (interactive "fFind file read-only other window: \nZCoding system: ")
- (if codesys
- (let ((coding-system-for-read
- (get-coding-system codesys)))
- (find-file-other-window filename))
- (find-file-other-window filename))
+Optional second argument specifies the coding system to use when decoding
+the file. Interactively, with a prefix argument, you will be prompted for
+the coding system."
+ (interactive (list (read-file-name "Find file read-only other window: ")
+ (and current-prefix-arg
+ (read-coding-system "Coding system: "))
+ t))
+ (find-file-other-window filename codesys wildcards)
(setq buffer-read-only t)
(current-buffer))
-(defun find-file-read-only-other-frame (filename &optional codesys)
+(defun find-file-read-only-other-frame (filename &optional codesys wildcards)
"Edit file FILENAME in another frame but don't allow changes.
Like \\[find-file-other-frame] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing.
-Under XEmacs/Mule, optional second argument specifies the
-coding system to use when decoding the file. Interactively,
-with a prefix argument, you will be prompted for the coding system."
- (interactive "fFind file read-only other frame: \nZCoding system: ")
- (if codesys
- (let ((coding-system-for-read
- (get-coding-system codesys)))
- (find-file-other-frame filename))
- (find-file-other-frame filename))
+Optional second argument specifies the coding system to use when decoding
+the file. Interactively, with a prefix argument, you will be prompted for
+the coding system."
+ (interactive (list (read-file-name "Find file read-only other frame: ")
+ (and current-prefix-arg
+ (read-coding-system "Coding system: "))
+ t))
+ (find-file-other-frame filename codesys wildcards)
(setq buffer-read-only t)
(current-buffer))
+;;; End Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
(defun find-alternate-file-other-window (filename &optional codesys)
"Find file FILENAME as a replacement for the file in the next window.
(save-excursion
(set-buffer (car list))
(if (and buffer-file-number
- (equal buffer-file-number number)
+ (equal buffer-file-number number)
;; Verify this buffer's file number
;; still belongs to its file.
(file-exists-p buffer-file-name)
"Try to use dired to open FILENAME, which is directory."
(if (and (fboundp 'dired-noselect) find-file-run-dired)
(dired-noselect (if find-file-use-truenames
- (abbreviate-file-name (file-truename filename))
- filename))
+ (abbreviate-file-name (file-truename filename))
+ filename))
(error "%s is a directory" filename)))
(defun find-file-find-magic (filename)
"Find entry in `find-file-magic-files-alist' that matches FILENAME."
(find filename find-file-magic-files-alist :key #'car
- :test #'(lambda (fn predicate)
- (funcall predicate fn))))
-
-(defun find-file-noselect (filename &optional nowarn rawfile)
+ :test #'(lambda (fn predicate)
+ (and (file-exists-p fn)
+ (funcall predicate fn)))))
+
+;;; Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
+(defcustom find-file-wildcards t
+ "*Non-nil means file-visiting commands should handle wildcards.
+For example, if you specify `*.c', that would visit all the files
+whose names match the pattern."
+ :group 'files
+; :version "20.4"
+ :type 'boolean)
+
+(defcustom find-file-suppress-same-file-warnings nil
+ "*Non-nil means suppress warning messages for symlinked files.
+When nil, Emacs prints a warning when visiting a file that is already
+visited, but with a different name. Setting this option to t
+suppresses this warning."
+ :group 'files
+; :version "21.1"
+ :type 'boolean)
+
+;;; FIXME: the #'loop here is generating one of those 'variable G26164
+;;; bound but not referenced' warnings you get from cl loops. Might
+;;; be able to fix this by using #'mapfam instead. --SY.
+(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
verify that the file has not changed since visited or saved.
If NOWARN is non-nil, warning messages will be suppressed.
If RAWFILE is non-nil, the file is read literally."
(setq filename (abbreviate-file-name (expand-file-name filename)))
- ;; Try magic files first
+ ;; SXEmacs addition:: Try magic files first
(let ((mfa-item (find-file-find-magic filename)))
(if mfa-item
- (funcall (cdr mfa-item) filename)
-
- (let* ((buf (get-file-buffer filename))
- (truename (abbreviate-file-name (file-truename filename)))
- (number (nthcdr 10 (file-attributes truename)))
+ (funcall (cdr mfa-item) filename)
+ ;; End SXEmacs magic
+ (if (file-directory-p filename)
+ (or (and find-file-run-dired
+ (loop for fn in find-directory-functions
+ for x = (and (fboundp fn)
+ (funcall fn
+ (if find-file-use-truenames
+ (abbreviate-file-name
+ (file-truename filename))
+ filename)))
+ if x
+ return x))
+ (error "%s is a directory" filename))
+ (if (and wildcards
+ find-file-wildcards
+ (not (string-match "\\`/:" filename))
+ (string-match "[[*?]" filename))
+ (let ((files (condition-case nil
+ (file-expand-wildcards filename t)
+ (error (list filename))))
+ (find-file-wildcards nil))
+ (if (null files)
+ (find-file-noselect filename)
+ (mapcar #'find-file-noselect files)))
+ (let* ((buf (get-file-buffer filename))
+ (truename (abbreviate-file-name (file-truename filename)))
+ (number (nthcdr 10 (file-attributes truename)))
; ;; Find any buffer for a file which has same truename.
; (other (and (not buf) (find-buffer-visiting filename)))
- (error nil))
-
-; ;; Let user know if there is a buffer with the same truename.
-; (if (and (not buf) same-truename (not nowarn))
-; (message "%s and %s are the same file (%s)"
-; filename (buffer-file-name same-truename)
-; truename)
-; (if (and (not buf) same-number (not nowarn))
-; (message "%s and %s are the same file"
-; filename (buffer-file-name same-number))))
-; ;; Optionally also find that buffer.
-; (if (or find-file-existing-other-name find-file-visit-truename)
-; (setq buf (or same-truename same-number)))
-
- (when (and buf
- (or find-file-compare-truenames find-file-use-truenames)
- (not nowarn))
- (save-excursion
- (set-buffer buf)
- (if (not (string-equal buffer-file-name filename))
- (message "%s and %s are the same file (%s)"
- filename buffer-file-name
- buffer-file-truename))))
-
- (if buf
- (or nowarn
- (verify-visited-file-modtime buf)
- (cond ((not (file-exists-p filename))
- (error "File %s no longer exists!" filename))
- ;; Certain files should be reverted automatically
- ;; if they have changed on disk and not in the buffer.
- ((and (not (buffer-modified-p buf))
- (dolist (rx revert-without-query nil)
- (when (string-match rx filename)
- (return t))))
- (with-current-buffer buf
- (message "Reverting file %s..." filename)
- (revert-buffer t t)
- (message "Reverting file %s... done" filename)))
- ((yes-or-no-p
- (if (string= (file-name-nondirectory filename)
- (buffer-name buf))
- (format
- (if (buffer-modified-p buf)
- (gettext "File %s changed on disk. Discard your edits? ")
- (gettext "File %s changed on disk. Reread from disk? "))
- (file-name-nondirectory filename))
- (format
- (if (buffer-modified-p buf)
- (gettext "File %s changed on disk. Discard your edits in %s? ")
- (gettext "File %s changed on disk. Reread from disk into %s? "))
- (file-name-nondirectory filename)
- (buffer-name buf))))
- (with-current-buffer buf
- (revert-buffer t t)))))
- ;; Else: we must create a new buffer for filename
- (save-excursion
-;;; The truename stuff makes this obsolete.
-;;; (let* ((link-name (car (file-attributes filename)))
-;;; (linked-buf (and (stringp link-name)
-;;; (get-file-buffer link-name))))
-;;; (if (bufferp linked-buf)
-;;; (message "Symbolic link to file in buffer %s"
-;;; (buffer-name linked-buf))))
- (setq buf (create-file-buffer filename))
- ;; Catch various signals, such as QUIT, and kill the buffer
- ;; in that case.
- (condition-case data
- (progn
- (set-buffer-major-mode buf)
- (set-buffer buf)
- (erase-buffer)
- (condition-case ()
- (if rawfile
- (insert-file-contents-literally filename t)
- (insert-file-contents filename t))
- (file-error
- (when (and (file-exists-p filename)
- (not (file-readable-p filename)))
- (signal 'file-error (list "File is not readable" filename)))
- (if rawfile
- ;; Unconditionally set error
- (setq error t)
- (or
- ;; Run find-file-not-found-hooks until one returns non-nil.
- (run-hook-with-args-until-success 'find-file-not-found-hooks)
- ;; If they fail too, set error.
- (setq error t)))))
- ;; Find the file's truename, and maybe use that as visited name.
- ;; automatically computed in XEmacs, unless jka-compr was used!
- (unless buffer-file-truename
- (setq buffer-file-truename truename))
- (setq buffer-file-number number)
- (and find-file-use-truenames
- ;; This should be in C. Put pathname
- ;; abbreviations that have been explicitly
- ;; requested back into the pathname. Most
- ;; importantly, strip out automounter /tmp_mnt
- ;; directories so that auto-save will work
- (setq buffer-file-name (abbreviate-file-name buffer-file-name)))
- ;; Set buffer's default directory to that of the file.
- (setq default-directory (file-name-directory buffer-file-name))
- ;; Turn off backup files for certain file names. Since
- ;; this is a permanent local, the major mode won't eliminate it.
- (and (not (funcall backup-enable-predicate buffer-file-name))
- (progn
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t)))
- (if rawfile
- ;; #### FSF 20.3 sets buffer-file-coding-system to
- ;; `no-conversion' here. Should we copy? It also
- ;; makes `find-file-literally' a local variable
- ;; and sets it to t.
- nil
- (after-find-file error (not nowarn))
- (setq buf (current-buffer))))
- (t
- (kill-buffer buf)
- (signal (car data) (cdr data))))
- ))
- buf))))
-\f
-;; FSF has `insert-file-literally' and `find-file-literally' here.
+ )
+
+; ;; Let user know if there is a buffer with the same truename.
+; (if other
+; (progn
+; (or nowarn
+; find-file-suppress-same-file-warnings
+; (string-equal filename (buffer-file-name other))
+; (message "%s and %s are the same file"
+; filename (buffer-file-name other)))
+; ;; Optionally also find that buffer.
+; (if (or find-file-existing-other-name find-file-visit-truename)
+; (setq buf other))))
+
+ (when (and buf
+ (or find-file-compare-truenames find-file-use-truenames)
+ (not find-file-suppress-same-file-warnings)
+ (not nowarn))
+ (save-excursion
+ (set-buffer buf)
+ (if (not (string-equal buffer-file-name filename))
+ (message "%s and %s are the same file (%s)"
+ filename buffer-file-name
+ buffer-file-truename))))
+
+ (if buf
+ (progn
+ (or nowarn
+ (verify-visited-file-modtime buf)
+ (cond ((not (file-exists-p filename))
+ (error "File %s no longer exists!" filename))
+ ;; Certain files should be reverted automatically
+ ;; if they have changed on disk and not in the buffer.
+ ((and (not (buffer-modified-p buf))
+ (dolist (rx revert-without-query nil)
+ (when (string-match rx filename)
+ (return t))))
+ (with-current-buffer buf
+ (message "Reverting file %s..." filename)
+ (revert-buffer t t)
+ (message "Reverting file %s... done" filename)))
+ ((yes-or-no-p
+ (if (string= (file-name-nondirectory filename)
+ (buffer-name buf))
+ (format
+ (if (buffer-modified-p buf)
+ (gettext "File %s changed on disk. Discard your edits? ")
+ (gettext "File %s changed on disk. Reread from disk? "))
+ (file-name-nondirectory filename))
+ (format
+ (if (buffer-modified-p buf)
+ (gettext "File %s changed on disk. Discard your edits in %s? ")
+ (gettext "File %s changed on disk. Reread from disk into %s? "))
+ (file-name-nondirectory filename)
+ (buffer-name buf))))
+ (with-current-buffer buf
+ (revert-buffer t t)))))
+ (when (not (eq rawfile (not (null find-file-literally))))
+ (with-current-buffer buf
+ (if (buffer-modified-p)
+ (if (y-or-n-p (if rawfile
+ "Save file and revisit literally? "
+ "Save file and revisit non-literally? "))
+ (progn
+ (save-buffer)
+ (find-file-noselect-1 buf filename nowarn
+ rawfile truename number))
+ (if (y-or-n-p (if rawfile
+ "Discard your edits and revisit file literally? "
+ "Discard your edits and revisit file non-literally? "))
+ (find-file-noselect-1 buf filename nowarn
+ rawfile truename number)
+ (error (if rawfile "File already visited non-literally"
+ "File already visited literally"))))
+ (if (y-or-n-p (if rawfile
+ "Revisit file literally? "
+ "Revisit file non-literally? "))
+ (find-file-noselect-1 buf filename nowarn
+ rawfile truename number)
+ (error (if rawfile "File already visited non-literally"
+ "File already visited literally"))))))
+ ;; Return the buffer we are using.
+ buf)
+ ;; Create a new buffer.
+ (setq buf (create-file-buffer filename))
+ ;; Catch various signals, such as QUIT, and kill the buffer
+ ;; in that case.
+ (condition-case data
+ (progn
+ (set-buffer-major-mode buf)
+ ;; find-file-noselect-1 may use a different buffer.
+ (find-file-noselect-1 buf filename nowarn
+ rawfile truename number))
+ (t
+ (kill-buffer buf)
+ (signal (car data) (cdr data)))))))))))
+
+(defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
+ (let ((inhibit-read-only t)
+ error)
+ (with-current-buffer buf
+ (kill-local-variable 'find-file-literally)
+ ;; Needed in case we are re-visiting the file with a different
+ ;; text representation.
+ (kill-local-variable 'buffer-file-coding-system)
+ (erase-buffer)
+; (and (default-value 'enable-multibyte-characters)
+; (not rawfile)
+; (set-buffer-multibyte t))
+ (condition-case ()
+ (if rawfile
+ (insert-file-contents-literally filename t)
+ (insert-file-contents filename t))
+ (file-error
+ (when (and (file-exists-p filename)
+ (not (file-readable-p filename)))
+ (signal 'file-error (list "File is not readable" filename)))
+ (if rawfile
+ ;; Unconditionally set error
+ (setq error t)
+ (or
+ ;; Run find-file-not-found-hooks until one returns non-nil.
+ (run-hook-with-args-until-success 'find-file-not-found-hooks)
+ ;; If they fail too, set error.
+ (setq error t)))))
+ ;; Find the file's truename, and maybe use that as visited name.
+ ;; automatically computed in XEmacs, unless jka-compr was used!
+ (unless buffer-file-truename
+ (setq buffer-file-truename truename))
+ (setq buffer-file-number number)
+ (and find-file-use-truenames
+ ;; This should be in C. Put pathname
+ ;; abbreviations that have been explicitly
+ ;; requested back into the pathname. Most
+ ;; importantly, strip out automounter /tmp_mnt
+ ;; directories so that auto-save will work
+ (setq buffer-file-name (abbreviate-file-name buffer-file-name)))
+ ;; Set buffer's default directory to that of the file.
+ (setq default-directory (file-name-directory buffer-file-name))
+ ;; Turn off backup files for certain file names. Since
+ ;; this is a permanent local, the major mode won't eliminate it.
+ (and (not (funcall backup-enable-predicate buffer-file-name))
+ (progn
+ (make-local-variable 'backup-inhibited)
+ (setq backup-inhibited t)))
+ (if rawfile
+ (progn
+ (setq buffer-file-coding-system 'no-conversion)
+ (make-local-variable 'find-file-literally)
+ (setq find-file-literally t))
+ (after-find-file error (not nowarn))
+ (setq buf (current-buffer)))
+ (current-buffer))))
+
+(defun insert-file-literally (filename)
+ "Insert contents of file FILENAME into buffer after point with no conversion.
+
+This function is meant for the user to run interactively.
+Don't call it from programs! Use `insert-file-contents-literally' instead.
+\(Its calling sequence is different; see its documentation)."
+ (interactive "*fInsert file literally: ")
+ (if (file-directory-p filename)
+ (signal 'file-error (list "Opening input file" "file is a directory"
+ filename)))
+ (let ((tem (insert-file-contents-literally filename)))
+ (push-mark (+ (point) (car (cdr tem))))))
+
+(defvar find-file-literally nil
+ "Non-nil if this buffer was made by `find-file-literally' or equivalent.
+This is a permanent local.")
+(put 'find-file-literally 'permanent-local t)
+
+(defun find-file-literally (filename)
+ "Visit file FILENAME with no conversion of any kind.
+Format conversion and character code conversion are both disabled,
+and multibyte characters are disabled in the resulting buffer.
+The major mode used is Fundamental mode regardless of the file name,
+and local variable specifications in the file are ignored.
+Automatic uncompression and adding a newline at the end of the
+file due to `require-final-newline' is also disabled.
+
+You cannot absolutely rely on this function to result in
+visiting the file literally. If Emacs already has a buffer
+which is visiting the file, you get the existing buffer,
+regardless of whether it was created literally or not.
+
+In a Lisp program, if you want to be sure of accessing a file's
+contents literally, you should create a temporary buffer and then read
+the file contents into it using `insert-file-contents-literally'."
+ (interactive "FFind file literally: ")
+ (switch-to-buffer (find-file-noselect filename nil t)))
+;;; End Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
+\f
(defvar after-find-file-from-revert-buffer nil)
(defun after-find-file (&optional error warn noauto
(signal 'quit nil))))
nil))))
(when msg
- (message "%s" msg)
- (unless not-serious
- (save-excursion (sit-for 1 t)))))
+ (message "%s" msg)
+ (unless not-serious
+ (save-excursion (sit-for 1 t)))))
(if (and auto-save-default (not noauto))
(auto-save-mode t)))
(unless nomodes
(interactive)
(or find-file (funcall (or default-major-mode 'fundamental-mode)))
(and (condition-case err
- (progn (set-auto-mode)
- t)
- (error (message "File mode specification error: %s"
- (prin1-to-string err))
- nil))
+ (progn (set-auto-mode)
+ t)
+ (error (message "File mode specification error: %s"
+ (prin1-to-string err))
+ nil))
(condition-case err
- (hack-local-variables (not find-file))
- (error (lwarn 'local-variables 'warning
+ (hack-local-variables (not find-file))
+ (error (lwarn 'local-variables 'warning
"File local-variables error: %s"
(error-message-string err))))))
;(eval-when-compile
; (require 'regexp-opt)
; (list
-; (format "\\.\\(?:%s\\)\\'"
+; (format "\\.\\(?:%s\\)\\'"
; (regexp-opt
; '(
; ;; Compressed files
; "7Z" "7z" "ARC" "EAR" "JAR" "LZH" "RAR" "WAR"
-; "XPI" "Z" "ZIP" "ZOO" "arc" "bz2" "ear" "gz"
+; "XPI" "Z" "ZIP" "ZOO" "arc" "bz2" "ear" "gz"
; "jar" "tar" "tgz" "tiff" "war" "xpi" "zip" "zoo"
; "zoo" "lha" "lzh" "lzma" "xz"
; ;; Code
nil ; set by command-line
"File name including directory of user's initialization file.
-This normally defaults to \"~/.sxemacs/init.el\", if you are a XEmacs
-user you can get up and running quickly by symlinking \"~/.sxemacs\"
-to your old \"~/.xemacs\" directory.")
+This normally defaults to \"${XDG_CONFIG_HOME}/sxemacs/init.el\", if
+you are a XEmacs user you can get up and running quickly by symlinking
+your old \"~/.xemacs\" directory.")
(defun set-auto-mode (&optional just-from-file-name)
"Select major mode appropriate for current buffer.
;; this buffer isn't associated with a file.
(null buffer-file-name)
(let ((name (file-name-sans-versions buffer-file-name))
- (keep-going t))
- (while keep-going
- (setq keep-going nil)
- (let ((alist auto-mode-alist)
- (mode nil))
+ (keep-going t))
+ (while keep-going
+ (setq keep-going nil)
+ (let ((alist auto-mode-alist)
+ (mode nil))
- ;; Find first matching alist entry.
+ ;; Find first matching alist entry.
;; #### This is incorrect. In NT, case sensitivity is a volume
;; property. For instance, NFS mounts *are* case sensitive.
(setq mode (cdr (car alist)))
(setq alist nil))
(setq alist (cdr alist)))))))
- (if mode
+ (if mode
(if (not (fboundp mode))
- (let ((name (declare-fboundp (package-get-package-provider mode))))
- (if name
- (message "Mode %s is not installed. Download package %s" mode name)
- (message "Mode %s either doesn't exist or is not a known package" mode))
- (sit-for 2)
- (error "%s" mode))
+ (let ((name (declare-fboundp (package-get-package-provider mode))))
+ (if name
+ (message "Mode %s is not installed. Download package %s" mode name)
+ (message "Mode %s either doesn't exist or is not a known package" mode))
+ (sit-for 2)
+ (error "%s" mode))
(unless (and just-from-file-name
(or
;; Don't reinvoke major mode.
(setq temp (cdr temp))
temp))))
(progn
- ;; Look for variables in the -*- line.
- (hack-local-variables-prop-line force)
- ;; Look for "Local variables:" block in last page.
- (hack-local-variables-last-page force)))
+ ;; Look for variables in the -*- line.
+ (hack-local-variables-prop-line force)
+ ;; Look for "Local variables:" block in last page.
+ (hack-local-variables-last-page force)))
(run-hooks 'hack-local-variables-hook))
;;; Local variables may be specified in the last page of the file (within 3k
(defun hack-local-variables-p (modeline)
(or (eq enable-local-variables t)
(and enable-local-variables
- (save-window-excursion
- (condition-case nil
- (switch-to-buffer (current-buffer))
- (error
- ;; If we fail to switch in the selected window,
- ;; it is probably a minibuffer.
- ;; So try another window.
- (condition-case nil
- (switch-to-buffer-other-window (current-buffer))
- (error
- (switch-to-buffer-other-frame (current-buffer))))))
- (or modeline (save-excursion
- (beginning-of-line)
- (set-window-start (selected-window) (point))))
- (y-or-n-p (format
- "Set local variables as specified %s of %s? "
- (if modeline "in -*- line" "at end")
- (if buffer-file-name
- (file-name-nondirectory buffer-file-name)
- (concat "buffer " (buffer-name)))))))))
+ (save-window-excursion
+ (condition-case nil
+ (switch-to-buffer (current-buffer))
+ (error
+ ;; If we fail to switch in the selected window,
+ ;; it is probably a minibuffer.
+ ;; So try another window.
+ (condition-case nil
+ (switch-to-buffer-other-window (current-buffer))
+ (error
+ (switch-to-buffer-other-frame (current-buffer))))))
+ (or modeline (save-excursion
+ (beginning-of-line)
+ (set-window-start (selected-window) (point))))
+ (y-or-n-p (format
+ "Set local variables as specified %s of %s? "
+ (if modeline "in -*- line" "at end")
+ (if buffer-file-name
+ (file-name-nondirectory buffer-file-name)
+ (concat "buffer " (buffer-name)))))))))
(defun hack-local-variables-last-page (&optional force)
;; Set local variables set in the "Local Variables:" block of the last page.
(if (let ((case-fold-search t))
(and (search-forward "Local Variables:" nil t)
(or force
- (hack-local-variables-p nil))))
+ (hack-local-variables-p nil))))
(let ((continue t)
prefix prefixlen suffix start
- (enable-local-eval enable-local-eval))
+ (enable-local-eval enable-local-eval))
;; The prefix is what comes before "local variables:" in its line.
;; The suffix is what comes after "local variables:" in its line.
(skip-chars-forward " \t")
(or (if suffix (looking-at suffix) (eolp))
(error "Local variables entry is terminated incorrectly"))
;; Set the variable. "Variables" mode and eval are funny.
- (hack-one-local-variable var val))))))))
+ (hack-one-local-variable var val))))))))
;; jwz - New Version 20.1/19.15
(defun hack-local-variables-prop-line (&optional force)
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename))))
(if (string-match #r"\.[^.]*\'" file)
- (substring file (+ (match-beginning 0) (if period 0 1)))
- (if period
- "")))))
+ (substring file (+ (match-beginning 0) (if period 0 1)))
+ (if period
+ "")))))
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
;; outermost call).
;;
;; Ugh, have to duplicate logic of run-hook-with-args-until-success
- (let ((hooks (append (files-fetch-hook-value 'write-contents-hooks)
- (files-fetch-hook-value
+ (let ((hooks (append (files-fetch-hook-value 'write-contents-hooks)
+ (files-fetch-hook-value
'local-write-file-hooks)
- (files-fetch-hook-value 'write-file-hooks)))
+ (files-fetch-hook-value 'write-file-hooks)))
(after-save-hook nil)
- (local-write-file-hooks nil)
+ (local-write-file-hooks nil)
(write-contents-hooks nil)
(write-file-hooks nil)
done)
- (while (and hooks
- (let ((continue-save-buffer-hooks-tail hooks))
- (not (setq done (funcall (car hooks))))))
- (setq hooks (cdr hooks)))
+ (while (and hooks
+ (let ((continue-save-buffer-hooks-tail hooks))
+ (not (setq done (funcall (car hooks))))))
+ (setq hooks (cdr hooks)))
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
(if (not done)
(interactive "_P")
(setq buffer-read-only
(if (null arg)
- (not buffer-read-only)
- (> (prefix-numeric-value arg) 0)))
+ (not buffer-read-only)
+ (> (prefix-numeric-value arg) 0)))
;; Force modeline redisplay
(redraw-modeline))
(found nil)
(delay-prompt nil)
(auto-save-p (and (not ignore-auto)
- (recent-auto-save-p)
+ (recent-auto-save-p)
buffer-auto-save-file-name
(file-readable-p buffer-auto-save-file-name)
(y-or-n-p
;; ... and if different, prompt
(or noconfirm found
(and delay-prompt
- (yes-or-no-p
+ (yes-or-no-p
(format "Revert buffer from file %s? "
file-name))))))
;; If file was backed up but has changed since,
bmax (point-max))))))
(if (not (and (eq bmin (point-min))
(eq bmax (point-max))
- (eq (compare-buffer-substrings
+ (eq (compare-buffer-substrings
newbuf bmin bmax (current-buffer) bmin bmax) 0)))
newbuf
(and (kill-buffer newbuf) nil))))
With prefix argument ARG, turn auto-saving on if positive, else off."
(interactive "P")
(setq buffer-auto-save-file-name
- (and (if (null arg)
+ (and (if (null arg)
(or (not buffer-auto-save-file-name)
;; If autosave is off because buffer has shrunk,
;; then toggling should turn it on.
:type 'string
:group 'dired)
+;;; Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
+(defun file-expand-wildcards (pattern &optional full)
+ "Expand wildcard pattern PATTERN.
+This returns a list of file names which match the pattern.
+
+If PATTERN is written as an absolute relative file name,
+the values are absolute also.
+
+If PATTERN is written as a relative file name, it is interpreted
+relative to the current default directory, `default-directory'.
+The file names returned are normally also relative to the current
+default directory. However, if FULL is non-nil, they are absolute."
+ (let* ((nondir (file-name-nondirectory pattern))
+ (dirpart (file-name-directory pattern))
+ ;; A list of all dirs that DIRPART specifies.
+ ;; This can be more than one dir
+ ;; if DIRPART contains wildcards.
+ (dirs (if (and dirpart (string-match "[[*?]" dirpart))
+ (mapcar 'file-name-as-directory
+ (file-expand-wildcards (directory-file-name dirpart)))
+ (list dirpart)))
+ contents)
+ (while dirs
+ (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
+ (file-directory-p (directory-file-name (car dirs))))
+ (let ((this-dir-contents
+ ;; Filter out "." and ".."
+ (nset-difference (directory-files (or (car dirs) ".") full
+ (wildcard-to-regexp nondir))
+ '("." "..") :test #'equal)))
+ (setq contents
+ (nconc
+ (if (and (car dirs) (not full))
+ (mapcar (function (lambda (name) (concat (car dirs) name)))
+ this-dir-contents)
+ this-dir-contents)
+ contents))))
+ (setq dirs (cdr dirs)))
+ contents))
+;;; End Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
+
(defun list-directory (dirname &optional verbose)
"Display a list of files in or matching DIRNAME, a la `ls'.
DIRNAME is globbed by the shell if necessary.
(let ((wildcard (not (file-directory-p dirname))))
(insert-directory dirname switches wildcard (not wildcard)))))))
+;;; Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
+(defun shell-quote-wildcard-pattern (pattern)
+ "Quote characters special to the shell in PATTERN, leave wildcards alone.
+
+PATTERN is assumed to represent a file-name wildcard suitable for the
+underlying filesystem. For Unix and GNU/Linux, the characters from the
+set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all
+the parts of the pattern which don't include wildcard characters are
+quoted with double quotes.
+Existing quote characters in PATTERN are left alone, so you can pass
+PATTERN that already quotes some of the special characters."
+ (save-match-data
+ (cond
+ ((memq system-type '(ms-dos windows-nt))
+ ;; DOS/Windows don't allow `"' in file names. So if the
+ ;; argument has quotes, we can safely assume it is already
+ ;; quoted by the caller.
+ (if (or (string-match "[\"]" pattern)
+ ;; We quote [&()#$'] in case their shell is a port of a
+ ;; Unixy shell. We quote [,=+] because stock DOS and
+ ;; Windows shells require that in some cases, such as
+ ;; passing arguments to batch files that use positional
+ ;; arguments like %1.
+ (not (string-match "[ \t;&()#$',=+]" pattern)))
+ pattern
+ (let ((result "\"")
+ (beg 0)
+ end)
+ (while (string-match "[*?]+" pattern beg)
+ (setq end (match-beginning 0)
+ result (concat result (substring pattern beg end)
+ "\""
+ (substring pattern end (match-end 0))
+ "\"")
+ beg (match-end 0)))
+ (concat result (substring pattern beg) "\""))))
+ (t
+ (let ((beg 0))
+ (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
+ (setq pattern
+ (concat (substring pattern 0 (match-beginning 0))
+ "\\"
+ (substring pattern (match-beginning 0)))
+ beg (1+ (match-end 0)))))
+ pattern))))
+;;; End Sync: XEmacs 21.5 (cb65bfaf7110 tip) 2015-07-03 --SY
+
(defvar insert-directory-program "ls"
"Absolute or relative name of the `ls' program used by `insert-directory'.")
;; File lines should display the basename.
;; - must be consistent with
;; - functions dired-move-to-filename, (these two define what a file line is)
-;; dired-move-to-end-of-filename,
+;; dired-move-to-end-of-filename,
;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
-;; dired-insert-headerline
-;; dired-after-subdir-garbage (defines what a "total" line is)
+;; dired-insert-headerline
+;; dired-after-subdir-garbage (defines what a "total" line is)
;; - variable dired-subdir-regexp
(defun insert-directory (file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
projects / sxemacs / blobdiff