xemacs-beta: lisp/files.el comparison

comparison lisp/files.el @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14

author	cvs
date	Mon, 13 Aug 2007 11:20:41 +0200
parents	de805c49cfc1
children	95016f13131a

comparison

equal deleted inserted replaced

-:12e008d41344
+:697ef44129c6
 	    (setq filename
 		  (concat (cdr (car tail)) (substring filename (match-end 0)))))
 	  (setq tail (cdr tail))))
 (when hack-homedir
 	;; Compute and save the abbreviated homedir name.
-	;; We defer computing this until the first time it's needed,
+	;; We defer computing this until the first time it's needed, to
-	;; to give time for directory-abbrev-alist to be set properly.
+	;; give time for directory-abbrev-alist to be set properly.
-	;; We include the separator at the end, to avoid spurious
+	;; We include a slash at the end, to avoid spurious matches
-	;; matches such as `/usr/foobar' when the home dir is
+	;; such as `/usr/foobar' when the home dir is `/usr/foo'.
-	;; `/usr/foo'.
 	(or abbreviated-home-dir
 	    (setq abbreviated-home-dir
 		  (let ((abbreviated-home-dir "$foo"))
-		    (concat "\\`"
+		    (concat "\\`" (regexp-quote (abbreviate-file-name
-			    (regexp-quote
+						 (expand-file-name "~")))
-			     (abbreviate-file-name (expand-file-name "~")))
+			    "\\(/\\|\\'\\)"))))
-			    "\\("
-			    (regexp-quote (string directory-sep-char))
-			    "\\|\\'\\)"))))
 	;; If FILENAME starts with the abbreviated homedir,
 	;; make it start with `~' instead.
 	(if (and (string-match abbreviated-home-dir filename)
 		 ;; If the home dir is just /, don't change it.
-		 (not (and (= (match-end 0) 1)
+		 (not (and (= (match-end 0) 1) ;#### unix-specific
-			   (= (aref filename 0) directory-sep-char)))
+			   (= (aref filename 0) ?/)))
-		 (not (and (eq system-type 'windows-nt)
+		 (not (and (memq system-type '(ms-dos windows-nt))
 			   (save-match-data
-			     (string-match (concat "\\`[a-zA-Z]:"
+			     (string-match "^[a-zA-Z]:/$" filename)))))
-						   (regexp-quote
-						    (string directory-sep-char))
-						   "\\'")
-					   filename)))))
 	    (setq filename
 		  (concat "~"
-			  (match-string 1 filename)
+			  (substring filename
+				     (match-beginning 1) (match-end 1))
 			  (substring filename (match-end 0))))))
 filename)))
 (defcustom find-file-not-true-dirname-list nil
 "*List of logical names for which visiting shouldn't save the true dirname."
 		    nil
 		  (after-find-file error (not nowarn))
 		  (setq buf (current-buffer))))
 	    (t
 	     (kill-buffer buf)
-	     (signal (car data) (cdr data))))
+	     (signal (car data) (cdr data))))))
-	))
 buf)))
 ;; FSF has `insert-file-literally' and `find-file-literally' here.
 (defvar after-find-file-from-revert-buffer nil)
 ("\\.e\\'" . eiffel-mode)
 ("\\.mss\\'" . scribe-mode)
 ("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode)
 ("\\.icn\\'" . icon-mode)
 ("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode)
-("\\.pro\\'" . idlwave-mode)
 ;; #### Unix-specific!
 ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\\|logout\\)\\'" . sh-mode)
 ("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode)
 ("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode)
 ;; The following come after the ChangeLog pattern for the sake of
 ("^/tmp/fol/" . text-mode)
 ("\\.y\\'" . c-mode)
 ("\\.lex\\'" . c-mode)
 ("\\.m\\'" . objc-mode)
 ("\\.oak\\'" . scheme-mode)
-("\\.[sj]?html?\\'" . html-mode)
+("\\.s?html?\\'" . html-mode)
-("\\.jsp\\'" . html-mode)
-("\\.xml\\'" . xml-mode)
 ("\\.htm?l?3\\'" . html3-mode)
 ("\\.\\(?:sgml?\\|dtd\\)\\'" . sgml-mode)
 ("\\.c?ps\\'" . postscript-mode)
 ;; .emacs following a directory delimiter in either Unix or
 ;; Windows syntax.
 ("[/\\][._].*emacs\\'" . emacs-lisp-mode)
 ("\\.m4\\'" . autoconf-mode)
 ("configure\\.in\\'" . autoconf-mode)
 ("\\.ml\\'" . lisp-mode)
-("\\.ma?ke?\\'" . makefile-mode)
+("\\.ma?k\\'" . makefile-mode)
 ("[Mm]akefile\\(\\.\\|\\'\\)" . makefile-mode)
 ("\\.X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode)
 ;; #### The following three are Unix-specific (but do we care?)
 ("/app-defaults/" . xrdb-mode)
 ("\\.[^/]*wm2?\\(?:rc\\)?\\'" . winmgr-mode)
 ("^#!.*sh\\b" . sh-mode)
 ("perl"   . perl-mode)
 ("python" . python-mode)
 ("awk\\b" . awk-mode)
 ("rexx"   . rexx-mode)
-("scm\\|guile" . scheme-mode)
+("scm"    . scheme-mode)
-("emacs" . emacs-lisp-mode)
-("make" . makefile-mode)
 ("^:"     . sh-mode))
 "Alist mapping interpreter names to major modes.
 This alist is used to guess the major mode of a file based on the
 contents of the first line.  This line often contains something like:
 #!/bin/sh
 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
 When checking `inhibit-first-line-modes-regexps', we first discard
 from the end of the file name anything that matches one of these regexps.")
 (defvar user-init-file
-nil ; set by command-line
+"" ; set by command-line
 "File name including directory of user's initialization file.")
 (defun set-auto-mode (&optional just-from-file-name)
 "Select major mode appropriate for current buffer.
 This checks for a -*- mode tag in the buffer's text,
 (keep-going t))
 (while keep-going
 (setq keep-going nil)
 (let ((alist auto-mode-alist)
 (mode nil))
 ;; Find first matching alist entry.
-	      ;; #### This is incorrect. In NT, case sensitivity is a volume
-	      ;; property. For instance, NFS mounts *are* case sensitive.
-	      ;; Need internal function (file-name-case-sensitive f), F
-	      ;; being file or directory name. - kkm
 	      (let ((case-fold-search
-		     (eq system-type 'windows-nt)))
+		     (memq system-type '(windows-nt))))
 		(while (and (not mode) alist)
 		  (if (string-match (car (car alist)) name)
 		      (if (and (consp (cdr (car alist)))
 			       (nth 2 (car alist)))
 			  (progn
 		   (point))))
 	;; Parse the -*- line into the `result' alist.
 	(cond ((not (search-forward "-*-" end t))
 	       ;; doesn't have one.
 	       (setq force t))
-	      ((looking-at "[ \t]*\\([^ \t\n\r:;]+?\\)\\([ \t]*-\\*-\\)")
+	      ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
 	       ;; Antiquated form: "-*- ModeName -*-".
 	       (setq result
 		     (list (cons 'mode
 				 (intern (buffer-substring
 					  (match-beginning 1)
 	   (read-file-name "Write file: "
 			       (cdr (assq 'default-directory
 					  (buffer-local-variables)))
 			       nil nil (buffer-name)))
 	 t
-	 (if (and current-prefix-arg (featurep 'file-coding))
+	 (if (and current-prefix-arg (featurep 'mule))
 	     (read-coding-system "Coding system: "))))
 (and (eq (current-buffer) mouse-grabbed-buffer)
 (error "Can't write minibuffer window"))
 (or (null filename) (string-equal filename "")
 (progn
 		(if backup-info
 		    (condition-case ()
 			(let ((delete-old-versions
 			       ;; If have old versions to maybe delete,
 			       ;; ask the user to confirm now, before doing anything.
-			       ;; But don't actually delete till later.
+			       ;; But don't actually delete til later.
 			       (and targets
 				    (or (eq delete-old-versions t)
 					(eq delete-old-versions nil))
 				    (or delete-old-versions
 					(y-or-n-p (format "Delete excess backup versions of %s? "
 "")))))
 (defun make-backup-file-name (file)
 "Create the non-numeric backup file name for FILE.
 This is a separate function so you can redefine it for customization."
-(concat file "~"))
+(if (eq system-type 'ms-dos)
+(let ((fn (file-name-nondirectory file)))
+	(concat (file-name-directory file)
+		(if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
+		    (substring fn 0 (match-end 1)))
+		".bak"))
+(concat file "~")))
 (defun backup-file-name-p (file)
 "Return non-nil if FILE is a backup file name (numeric or not).
 This is a separate function so you can redefine it for customization.
 You may need to redefine `file-name-sans-versions' as well."
-(string-match "~\\'" file))
+(if (eq system-type 'ms-dos)
+(string-match "\\.bak\\'" file)
+(string-match "~\\'" file)))
 ;; This is used in various files.
 ;; The usage of bv-length is not very clean,
 ;; but I can't see a good alternative,
 ;; so as of now I am leaving it alone.
 (defun file-relative-name (filename &optional directory)
 "Convert FILENAME to be relative to DIRECTORY (default: default-directory).
 This function returns a relative file name which is equivalent to FILENAME
 when used with that default directory as the default.
-If this is impossible (which can happen on MS Windows when the file name
+If this is impossible (which can happen on MSDOS and Windows
-and directory use different drive names) then it returns FILENAME."
+when the file name and directory use different drive names)
+then it returns FILENAME."
 (save-match-data
 (let ((fname (expand-file-name filename)))
 (setq directory (file-name-as-directory
 		       (expand-file-name (or directory default-directory))))
 ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
 ;; drive names, they can't be relative, so return the absolute name.
-(if (and (eq system-type 'windows-nt)
+(if (and (memq system-type '(ms-dos windows-nt))
 	       (not (string-equal (substring fname  0 2)
 				  (substring directory 0 2))))
 	  filename
 	(let ((ancestor ".")
 	      (fname-dir (file-name-as-directory fname)))
 	       (format "%s has changed since visited or saved.  Save anyway? "
 		       (file-name-nondirectory buffer-file-name)))
 	      (error "Save not confirmed"))
 	  (save-restriction
 	    (widen)
+	    (and (> (point-max) 1)
-	    ;; Add final newline if required.  See `require-final-newline'.
+		 (/= (char-after (1- (point-max))) ?\n)
-	    (when (and (not (eq (char-before (point-max)) ?\n)) ; common case
+		 (not (and (eq selective-display t)
-		       (char-before (point-max))                ; empty buffer?
+			   (= (char-after (1- (point-max))) ?\r)))
-		       (not (and (eq selective-display t)
+		 (or (eq require-final-newline t)
-				 (eq (char-before (point-max)) ?\r)))
+		     (and require-final-newline
-		       (or (eq require-final-newline t)
+			  (y-or-n-p
-			   (and require-final-newline
+			   (format "Buffer %s does not end in newline.  Add one? "
-				(y-or-n-p
+				   (buffer-name)))))
-				 (format "Buffer %s does not end in newline.  Add one? "
+		 (save-excursion
-					 (buffer-name))))))
+		   (goto-char (point-max))
-	      (save-excursion
+		   (insert ?\n)))
-		(goto-char (point-max))
+	    ;;
-		(insert ?\n)))
 	    ;; Run the write-file-hooks until one returns non-null.
 	    ;; Bind after-save-hook to nil while running the
 	    ;; write-file-hooks so that if this function is called
 	    ;; recursively (from inside a write-file-hook) the
 	    ;; after-hooks will only get run once (from the
 				     (lambda (ignore)
 				       (exit-recursive-edit)))
 			       (recursive-edit)
 			       ;; Return nil to ask about BUF again.
 			       nil)
-		       "%_Display Buffer"))))
+		       "display the current buffer"))))
 	 (abbrevs-done
 	  (and save-abbrevs abbrevs-changed
 	       (progn
 		 (if (or arg
 			 (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
 			    (setq found t)))))
 		 (yes-or-no-p (format "Revert buffer from file %s? "
 				      file-name)))
 	     (run-hooks 'before-revert-hook)
 	     ;; If file was backed up but has changed since,
-	     ;; we should make another backup.
+	     ;; we shd make another backup.
 	     (and (not auto-save-p)
 		  (not (verify-visited-file-modtime (current-buffer)))
 		  (setq buffer-backed-up nil))
 	     ;; Get rid of all undo records for this buffer.
 	     (or (eq buffer-undo-list t)
 	(cond ((if (file-exists-p file)
 		   (not (file-newer-than-file-p file-name file))
 		 (not (file-exists-p file-name)))
 	       (error "Auto-save file %s not current" file-name))
 	      ((save-window-excursion
-		 (if (not (eq system-type 'windows-nt))
+		 (with-output-to-temp-buffer "*Directory*"
-		     (with-output-to-temp-buffer "*Directory*"
+		   (buffer-disable-undo standard-output)
-		       (buffer-disable-undo standard-output)
+		   (call-process "ls" nil standard-output nil
-		       (call-process "ls" nil standard-output nil
+				 (if (file-symlink-p file) "-lL" "-l")
-				     (if (file-symlink-p file) "-lL" "-l")
+				 file file-name))
-				     file file-name)))
 		 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
 	       (switch-to-buffer (find-file-noselect file t))
 	       (let ((buffer-read-only nil))
 		 (erase-buffer)
 		 (insert-file-contents file-name nil))
 					 'insert-directory)))
 (if handler
 	(funcall handler 'insert-directory file switches
 		 wildcard full-directory-p)
 (cond
-;; #### mswindows-insert-directory should be called
-;; nt-insert-directory - kkm.
 ((and (fboundp 'mswindows-insert-directory)
 	     (eq system-type 'windows-nt))
 	(mswindows-insert-directory file switches wildcard full-directory-p))
 (t
 	(if wildcard

Mercurial > hg > xemacs-beta

comparison lisp/files.el @ 412:697ef44129c6 r21-2-14