Mercurial > hg > xemacs-beta

comparison lisp/files.el @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents 1d62742628b6
children 6240c7796c7a
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
770 Choose the buffer's name using `generate-new-buffer-name'." 770 Choose the buffer's name using `generate-new-buffer-name'."
771 (get-buffer-create (generate-new-buffer-name name))) 771 (get-buffer-create (generate-new-buffer-name name)))
772 772
773 (defvar abbreviated-home-dir nil 773 (defvar abbreviated-home-dir nil
774 "The user's homedir abbreviated according to `directory-abbrev-alist'.") 774 "The user's homedir abbreviated according to `directory-abbrev-alist'.")
775
775 (defun abbreviate-file-name (filename &optional hack-homedir) 776 (defun abbreviate-file-name (filename &optional hack-homedir)
776 "Return a version of FILENAME shortened using `directory-abbrev-alist'. 777 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
777 See documentation of variable `directory-abbrev-alist' for more information. 778 See documentation of variable `directory-abbrev-alist' for more information.
778 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes 779 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes
779 \"~\" for the user's home directory." 780 \"~\" for the user's home directory."
787 ;; (setq filename (substring filename (1- (match-end 0))))) 788 ;; (setq filename (substring filename (1- (match-end 0)))))
788 (let ((tail directory-abbrev-alist)) 789 (let ((tail directory-abbrev-alist))
789 ;; If any elt of directory-abbrev-alist matches this name, 790 ;; If any elt of directory-abbrev-alist matches this name,
790 ;; abbreviate accordingly. 791 ;; abbreviate accordingly.
791 (while tail 792 (while tail
792 (when (string-match (car (car tail)) filename) 793 (if (string-match (car (car tail)) filename)
793 (setq filename 794 (setq filename
794 (concat (cdr (car tail)) (substring filename (match-end 0))))) 795 (concat (cdr (car tail)) (substring filename (match-end 0)))))
795 (setq tail (cdr tail)))) 796 (setq tail (cdr tail))))
796 (when hack-homedir 797 (if hack-homedir
797 ;; Compute and save the abbreviated homedir name. 798 (progn
798 ;; We defer computing this until the first time it's needed, 799 ;; Compute and save the abbreviated homedir name.
799 ;; to give time for directory-abbrev-alist to be set properly. 800 ;; We defer computing this until the first time it's needed, to
800 ;; We include the separator at the end, to avoid spurious 801 ;; give time for directory-abbrev-alist to be set properly.
801 ;; matches such as `/usr/foobar' when the home dir is 802 ;; We include a slash at the end, to avoid spurious matches
802 ;; `/usr/foo'. 803 ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
803 (or abbreviated-home-dir 804 (or abbreviated-home-dir
804 (setq abbreviated-home-dir 805 (setq abbreviated-home-dir
805 (let ((abbreviated-home-dir "$foo")) 806 (let ((abbreviated-home-dir "$foo"))
806 (concat "\\`" 807 (concat "\\`" (regexp-quote (abbreviate-file-name
807 (regexp-quote 808 (expand-file-name "~")))
808 (abbreviate-file-name (expand-file-name "~"))) 809 "\\(/\\|\\'\\)"))))
809 "\\(" 810 ;; If FILENAME starts with the abbreviated homedir,
810 (regexp-quote (string directory-sep-char)) 811 ;; make it start with `~' instead.
811 "\\|\\'\\)")))) 812 (if (and (string-match abbreviated-home-dir filename)
812 ;; If FILENAME starts with the abbreviated homedir, 813 ;; If the home dir is just /, don't change it.
813 ;; make it start with `~' instead. 814 (not (and (= (match-end 0) 1) ;#### unix-specific
814 (if (and (string-match abbreviated-home-dir filename) 815 (= (aref filename 0) ?/)))
815 ;; If the home dir is just /, don't change it. 816 (not (and (or (eq system-type 'ms-dos)
816 (not (and (= (match-end 0) 1) 817 (eq system-type 'windows-nt))
817 (= (aref filename 0) directory-sep-char))) 818 (save-match-data
818 (not (and (eq system-type 'windows-nt) 819 (string-match "^[a-zA-Z]:/$" filename)))))
819 (save-match-data 820 (setq filename
820 (string-match (concat "\\`[a-zA-Z]:" 821 (concat "~"
821 (regexp-quote 822 (substring filename
822 (string directory-sep-char)) 823 (match-beginning 1) (match-end 1))
823 "\\'") 824 (substring filename (match-end 0)))))))
824 filename)))))
825 (setq filename
826 (concat "~"
827 (match-string 1 filename)
828 (substring filename (match-end 0))))))
829 filename))) 825 filename)))
830 826
831 (defcustom find-file-not-true-dirname-list nil 827 (defcustom find-file-not-true-dirname-list nil
832 "*List of logical names for which visiting shouldn't save the true dirname. 828 "*List of logical names for which visiting shouldn't save the true dirname.
833 On VMS, when you visit a file using a logical name that searches a path, 829 On VMS, when you visit a file using a logical name that searches a path,
876 found)))) 872 found))))
877 873
878 (defun insert-file-contents-literally (filename &optional visit beg end replace) 874 (defun insert-file-contents-literally (filename &optional visit beg end replace)
879 "Like `insert-file-contents', q.v., but only reads in the file. 875 "Like `insert-file-contents', q.v., but only reads in the file.
880 A buffer may be modified in several ways after reading into the buffer due 876 A buffer may be modified in several ways after reading into the buffer due
881 to advanced Emacs features, such as format decoding, character code 877 to advanced Emacs features, such as file-name-handlers, format decoding,
882 conversion,find-file-hooks, automatic uncompression, etc. 878 find-file-hooks, etc.
883
884 This function ensures that none of these modifications will take place." 879 This function ensures that none of these modifications will take place."
885 (let ((wrap-func (find-file-name-handler filename 880 (let ((file-name-handler-alist nil)
886 'insert-file-contents-literally))) 881 (format-alist nil)
887 (if wrap-func 882 (after-insert-file-functions nil)
888 (funcall wrap-func 'insert-file-contents-literally filename 883 (find-buffer-file-type-function
889 visit beg end replace) 884 (if (fboundp 'find-buffer-file-type)
890 (let ((file-name-handler-alist nil) 885 (symbol-function 'find-buffer-file-type)
891 (format-alist nil) 886 nil)))
892 (after-insert-file-functions nil) 887 (unwind-protect
893 (coding-system-for-read 'binary) 888 (progn
894 (coding-system-for-write 'binary) 889 (fset 'find-buffer-file-type (lambda (filename) t))
895 (find-buffer-file-type-function 890 (insert-file-contents filename visit beg end replace))
896 (if (fboundp 'find-buffer-file-type) 891 (if find-buffer-file-type-function
897 (symbol-function 'find-buffer-file-type) 892 (fset 'find-buffer-file-type find-buffer-file-type-function)
898 nil))) 893 (fmakunbound 'find-buffer-file-type)))))
899 (unwind-protect
900 (progn
901 (fset 'find-buffer-file-type (lambda (filename) t))
902 (insert-file-contents filename visit beg end replace))
903 (if find-buffer-file-type-function
904 (fset 'find-buffer-file-type find-buffer-file-type-function)
905 (fmakunbound 'find-buffer-file-type)))))))
906 894
907 (defun find-file-noselect (filename &optional nowarn rawfile) 895 (defun find-file-noselect (filename &optional nowarn rawfile)
908 "Read file FILENAME into a buffer and return the buffer. 896 "Read file FILENAME into a buffer and return the buffer.
909 If a buffer exists visiting FILENAME, return that one, but 897 If a buffer exists visiting FILENAME, return that one, but
910 verify that the file has not changed since visited or saved. 898 verify that the file has not changed since visited or saved.
986 ;;; (get-file-buffer link-name)))) 974 ;;; (get-file-buffer link-name))))
987 ;;; (if (bufferp linked-buf) 975 ;;; (if (bufferp linked-buf)
988 ;;; (message "Symbolic link to file in buffer %s" 976 ;;; (message "Symbolic link to file in buffer %s"
989 ;;; (buffer-name linked-buf)))) 977 ;;; (buffer-name linked-buf))))
990 (setq buf (create-file-buffer filename)) 978 (setq buf (create-file-buffer filename))
991 ;; Catch various signals, such as QUIT, and kill the buffer 979 (set-buffer-major-mode buf)
992 ;; in that case. 980 (set-buffer buf)
993 (condition-case data 981 (erase-buffer)
994 (progn 982 (if rawfile
995 (set-buffer-major-mode buf) 983 (condition-case ()
996 (set-buffer buf) 984 (insert-file-contents-literally filename t)
997 (erase-buffer) 985 (file-error
998 (condition-case () 986 (when (and (file-exists-p filename)
999 (if rawfile 987 (not (file-readable-p filename)))
1000 (insert-file-contents-literally filename t) 988 (kill-buffer buf)
1001 (insert-file-contents filename t)) 989 (signal 'file-error (list "File is not readable" filename)))
1002 (file-error 990 ;; Unconditionally set error
1003 (when (and (file-exists-p filename) 991 (setq error t)))
1004 (not (file-readable-p filename))) 992 (condition-case ()
1005 (signal 'file-error (list "File is not readable" filename))) 993 (insert-file-contents filename t)
1006 (if rawfile 994 (file-error
1007 ;; Unconditionally set error 995 (when (and (file-exists-p filename)
1008 (setq error t) 996 (not (file-readable-p filename)))
1009 (or 997 (kill-buffer buf)
1010 ;; Run find-file-not-found-hooks until one returns non-nil. 998 (signal 'file-error (list "File is not readable" filename)))
1011 (run-hook-with-args-until-success 'find-file-not-found-hooks) 999 ;; Run find-file-not-found-hooks until one returns non-nil.
1012 ;; If they fail too, set error. 1000 (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
1013 (setq error t))))) 1001 ;; If they fail too, set error.
1014 ;; Find the file's truename, and maybe use that as visited name. 1002 (setq error t)))))
1015 ;; automatically computed in XEmacs, unless jka-compr was used! 1003 ;; Find the file's truename, and maybe use that as visited name.
1016 (unless buffer-file-truename 1004 ;; automatically computed in XEmacs, unless jka-compr was used!
1017 (setq buffer-file-truename truename)) 1005 (unless buffer-file-truename
1018 (setq buffer-file-number number) 1006 (setq buffer-file-truename truename))
1019 ;; On VMS, we may want to remember which directory in 1007 (setq buffer-file-number number)
1020 ;; a search list the file was found in. 1008 ;; On VMS, we may want to remember which directory in a search list
1021 (and (eq system-type 'vax-vms) 1009 ;; the file was found in.
1022 (let (logical) 1010 (and (eq system-type 'vax-vms)
1023 (if (string-match ":" (file-name-directory filename)) 1011 (let (logical)
1024 (setq logical (substring (file-name-directory filename) 1012 (if (string-match ":" (file-name-directory filename))
1025 0 (match-beginning 0)))) 1013 (setq logical (substring (file-name-directory filename)
1026 (not (member logical find-file-not-true-dirname-list))) 1014 0 (match-beginning 0))))
1027 (setq buffer-file-name buffer-file-truename)) 1015 (not (member logical find-file-not-true-dirname-list)))
1028 (and find-file-use-truenames 1016 (setq buffer-file-name buffer-file-truename))
1029 ;; This should be in C. Put pathname 1017 (and find-file-use-truenames
1030 ;; abbreviations that have been explicitly 1018 ;; This should be in C. Put pathname abbreviations that have
1031 ;; requested back into the pathname. Most 1019 ;; been explicitly requested back into the pathname. Most
1032 ;; importantly, strip out automounter /tmp_mnt 1020 ;; importantly, strip out automounter /tmp_mnt directories so
1033 ;; directories so that auto-save will work 1021 ;; that auto-save will work
1034 (setq buffer-file-name (abbreviate-file-name buffer-file-name))) 1022 (setq buffer-file-name (abbreviate-file-name buffer-file-name)))
1035 ;; Set buffer's default directory to that of the file. 1023 ;; Set buffer's default directory to that of the file.
1036 (setq default-directory (file-name-directory buffer-file-name)) 1024 (setq default-directory (file-name-directory buffer-file-name))
1037 ;; Turn off backup files for certain file names. Since 1025 ;; Turn off backup files for certain file names. Since
1038 ;; this is a permanent local, the major mode won't eliminate it. 1026 ;; this is a permanent local, the major mode won't eliminate it.
1039 (and (not (funcall backup-enable-predicate buffer-file-name)) 1027 (and (not (funcall backup-enable-predicate buffer-file-name))
1040 (progn 1028 (progn
1041 (make-local-variable 'backup-inhibited) 1029 (make-local-variable 'backup-inhibited)
1042 (setq backup-inhibited t))) 1030 (setq backup-inhibited t)))
1043 (if rawfile 1031 (if rawfile
1044 ;; #### FSF 20.3 sets buffer-file-coding-system to 1032 ;; #### FSF 20.3 sets buffer-file-coding-system to
1045 ;; `no-conversion' here. Should we copy? It also 1033 ;; `no-conversion' here. Should we copy? It also makes
1046 ;; makes `find-file-literally' a local variable 1034 ;; `find-file-literally' a local variable and sets it to t.
1047 ;; and sets it to t. 1035 nil
1048 nil 1036 (after-find-file error (not nowarn))
1049 (after-find-file error (not nowarn)) 1037 (setq buf (current-buffer)))))
1050 (setq buf (current-buffer))))
1051 (t
1052 (kill-buffer buf)
1053 (signal (car data) (cdr data))))))
1054 buf))) 1038 buf)))
1055 1039
1056 ;; FSF has `insert-file-literally' and `find-file-literally' here. 1040 ;; FSF has `insert-file-literally' and `find-file-literally' here.
1057 1041
1058 (defvar after-find-file-from-revert-buffer nil) 1042 (defvar after-find-file-from-revert-buffer nil)
1157 ;; `default-auto-mode-alist') for default stuff, such as some of the 1141 ;; `default-auto-mode-alist') for default stuff, such as some of the
1158 ;; entries below. 1142 ;; entries below.
1159 1143
1160 (defvar auto-mode-alist 1144 (defvar auto-mode-alist
1161 '(("\\.te?xt\\'" . text-mode) 1145 '(("\\.te?xt\\'" . text-mode)
1162 ("\\.[chi]\\'" . c-mode) 1146 ("\\.[ch]\\'" . c-mode)
1163 ("\\.el\\'" . emacs-lisp-mode) 1147 ("\\.el\\'" . emacs-lisp-mode)
1164 ("\\.\\(?:[CH]\\|cc\\|hh\\)\\'" . c++-mode) 1148 ("\\.\\([CH]\\|cc\\|hh\\)\\'" . c++-mode)
1165 ("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode) 1149 ("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode)
1166 ("\\.java\\'" . java-mode) 1150 ("\\.java\\'" . java-mode)
1167 ("\\.idl\\'" . idl-mode) 1151 ("\\.idl\\'" . idl-mode)
1168 ("\\.f\\(?:or\\)?\\'" . fortran-mode) 1152 ("\\.f\\(or\\)?\\'" . fortran-mode)
1169 ("\\.F\\(?:OR\\)?\\'" . fortran-mode) 1153 ("\\.F\\(OR\\)?\\'" . fortran-mode)
1170 ("\\.[fF]90\\'" . f90-mode) 1154 ("\\.[fF]90\\'" . f90-mode)
1171 ;;; Less common extensions come here 1155 ;;; Less common extensions come here
1172 ;;; so more common ones above are found faster. 1156 ;;; so more common ones above are found faster.
1173 ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode) 1157 ("\\.p[lm]\\'" . perl-mode)
1174 ("\\.py\\'" . python-mode) 1158 ("\\.py\\'" . python-mode)
1175 ("\\.texi\\(?:nfo\\)?\\'" . texinfo-mode) 1159 ("\\.texi\\(nfo\\)?\\'" . texinfo-mode)
1176 ("\\.ad[abs]\\'" . ada-mode) 1160 ("\\.ad[abs]\\'" . ada-mode)
1177 ("\\.c?l\\(?:i?sp\\)?\\'" . lisp-mode) 1161 ("\\.c?l\\(i?sp\\)?\\'" . lisp-mode)
1178 ("\\.p\\(?:as\\)?\\'" . pascal-mode) 1162 ("\\.p\\(as\\)?\\'" . pascal-mode)
1179 ("\\.ltx\\'" . latex-mode) 1163 ("\\.ltx\\'" . latex-mode)
1180 ("\\.[sS]\\'" . asm-mode) 1164 ("\\.[sS]\\'" . asm-mode)
1181 ("[Cc]hange.?[Ll]og?\\(?:.[0-9]+\\)?\\'" . change-log-mode) 1165 ("[Cc]hange.?[Ll]og?\\(.[0-9]+\\)?\\'" . change-log-mode)
1182 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) 1166 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
1183 ("\\.scm?\\(?:\\.[0-9]*\\)?\\'" . scheme-mode) 1167 ("\\.scm?\\(?:\\.[0-9]*\\)?\\'" . scheme-mode)
1184 ("\\.e\\'" . eiffel-mode) 1168 ("\\.e\\'" . eiffel-mode)
1185 ("\\.mss\\'" . scribe-mode) 1169 ("\\.mss\\'" . scribe-mode)
1186 ("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode) 1170 ("\\.m\\([mes]\\|an\\)\\'" . nroff-mode)
1187 ("\\.icn\\'" . icon-mode) 1171 ("\\.icn\\'" . icon-mode)
1188 ("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode) 1172 ("\\.\\([ckz]?sh\\|shar\\)\\'" . sh-mode)
1189 ("\\.[Pp][Rr][Oo]\\'" . idlwave-mode)
1190 ;; #### Unix-specific! 1173 ;; #### Unix-specific!
1191 ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\\|logout\\)\\'" . sh-mode) 1174 ("/\\.\\(bash_\\|z\\)?\\(profile\\|login\||logout\\)\\'" . sh-mode)
1192 ("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode) 1175 ("/\\.\\([ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode)
1193 ("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode) 1176 ("/\\.\\([kz]shenv\\|xsession\\)\\'" . sh-mode)
1194 ("\\.m?spec$" .sh-mode)
1195 ;; The following come after the ChangeLog pattern for the sake of 1177 ;; The following come after the ChangeLog pattern for the sake of
1196 ;; ChangeLog.1, etc. and after the .scm.[0-9] pattern too. 1178 ;; ChangeLog.1, etc. and after the .scm.[0-9] pattern too.
1197 ("\\.[12345678]\\'" . nroff-mode) 1179 ("\\.[12345678]\\'" . nroff-mode)
1198 ("\\.[tT]e[xX]\\'" . tex-mode) 1180 ("\\.[tT]e[xX]\\'" . tex-mode)
1199 ("\\.\\(?:sty\\|cls\\|bbl\\)\\'" . latex-mode) 1181 ("\\.\\(sty\\|cls\\|bbl\\)\\'" . latex-mode)
1200 ("\\.bib\\'" . bibtex-mode) 1182 ("\\.bib\\'" . bibtex-mode)
1201 ("\\.article\\'" . text-mode) 1183 ("\\.article\\'" . text-mode)
1202 ("\\.letter\\'" . text-mode) 1184 ("\\.letter\\'" . text-mode)
1203 ("\\.\\(?:tcl\\|exp\\)\\'" . tcl-mode) 1185 ("\\.\\(tcl\\|exp\\)\\'" . tcl-mode)
1204 ("\\.wrl\\'" . vrml-mode) 1186 ("\\.wrl\\'" . vrml-mode)
1205 ("\\.awk\\'" . awk-mode) 1187 ("\\.awk\\'" . awk-mode)
1206 ("\\.prolog\\'" . prolog-mode) 1188 ("\\.prolog\\'" . prolog-mode)
1207 ("\\.tar\\'" . tar-mode) 1189 ("\\.tar\\'" . tar-mode)
1208 ("\\.\\(?:arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode) 1190 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
1209 ;; Mailer puts message to be edited in /tmp/Re.... or Message 1191 ;; Mailer puts message to be edited in /tmp/Re.... or Message
1210 ;; #### Unix-specific! 1192 ;; #### Unix-specific!
1211 ("\\`/tmp/Re" . text-mode) 1193 ("\\`/tmp/Re" . text-mode)
1212 ("/Message[0-9]*\\'" . text-mode) 1194 ("/Message[0-9]*\\'" . text-mode)
1213 ("/drafts/[0-9]+\\'" . mh-letter-mode) 1195 ("/drafts/[0-9]+\\'" . mh-letter-mode)
1215 ("^/tmp/fol/" . text-mode) 1197 ("^/tmp/fol/" . text-mode)
1216 ("\\.y\\'" . c-mode) 1198 ("\\.y\\'" . c-mode)
1217 ("\\.lex\\'" . c-mode) 1199 ("\\.lex\\'" . c-mode)
1218 ("\\.m\\'" . objc-mode) 1200 ("\\.m\\'" . objc-mode)
1219 ("\\.oak\\'" . scheme-mode) 1201 ("\\.oak\\'" . scheme-mode)
1220 ("\\.[sj]?html?\\'" . html-mode) 1202 ("\\.s?html?\\'" . html-mode)
1221 ("\\.jsp\\'" . html-mode) 1203 ("\\.htm?l?3\\'" . html3-mode)
1222 ("\\.xml\\'" . xml-mode) 1204 ("\\.\\(sgml?\\|dtd\\)\\'" . sgml-mode)
1223 ("\\.\\(?:sgml?\\|dtd\\)\\'" . sgml-mode)
1224 ("\\.c?ps\\'" . postscript-mode) 1205 ("\\.c?ps\\'" . postscript-mode)
1225 ;; .emacs following a directory delimiter in either Unix or 1206 ;; .emacs following a directory delimiter in either Unix or
1226 ;; Windows syntax. 1207 ;; Windows syntax.
1227 ("[/\\][._].*emacs\\'" . emacs-lisp-mode) 1208 ("[/\\][._].*emacs\\'" . emacs-lisp-mode)
1228 ("\\.m4\\'" . autoconf-mode) 1209 ("\\.m4\\'" . autoconf-mode)
1229 ("configure\\.in\\'" . autoconf-mode) 1210 ("configure\\.in\\'" . autoconf-mode)
1230 ("\\.ml\\'" . lisp-mode) 1211 ("\\.ml\\'" . lisp-mode)
1231 ("\\.ma?ke?\\'" . makefile-mode) 1212 ("\\.ma?k\\'" . makefile-mode)
1232 ("[Mm]akefile\\(\\.\\|\\'\\)" . makefile-mode) 1213 ("[Mm]akefile\\(\\.\\|\\'\\)" . makefile-mode)
1233 ("\\.X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode) 1214 ("\\.X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode)
1234 ;; #### The following three are Unix-specific (but do we care?) 1215 ;; #### The following three are Unix-specific (but do we care?)
1235 ("/app-defaults/" . xrdb-mode) 1216 ("/app-defaults/" . xrdb-mode)
1236 ("\\.[^/]*wm2?\\(?:rc\\)?\\'" . winmgr-mode) 1217 ("\\.[^/]*wm\\'" . winmgr-mode)
1218 ("\\.[^/]*wm2?rc" . winmgr-mode)
1237 ("\\.[Jj][Pp][Ee]?[Gg]\\'" . image-mode) 1219 ("\\.[Jj][Pp][Ee]?[Gg]\\'" . image-mode)
1238 ("\\.[Pp][Nn][Gg]\\'" . image-mode) 1220 ("\\.[Pp][Nn][Gg]\\'" . image-mode)
1239 ("\\.[Gg][Ii][Ff]\\'" . image-mode) 1221 ("\\.[Gg][Ii][Ff]\\'" . image-mode)
1240 ("\\.[Tt][Ii][Ff][Ff]?\\'" . image-mode)
1241 ) 1222 )
1242 "Alist of filename patterns vs. corresponding major mode functions. 1223 "Alist of filename patterns vs. corresponding major mode functions.
1243 Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). 1224 Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
1244 \(NON-NIL stands for anything that is not nil; the value does not matter.) 1225 \(NON-NIL stands for anything that is not nil; the value does not matter.)
1245 Visiting a file whose name matches REGEXP specifies FUNCTION as the 1226 Visiting a file whose name matches REGEXP specifies FUNCTION as the
1255 ("^#!.*sh\\b" . sh-mode) 1236 ("^#!.*sh\\b" . sh-mode)
1256 ("perl" . perl-mode) 1237 ("perl" . perl-mode)
1257 ("python" . python-mode) 1238 ("python" . python-mode)
1258 ("awk\\b" . awk-mode) 1239 ("awk\\b" . awk-mode)
1259 ("rexx" . rexx-mode) 1240 ("rexx" . rexx-mode)
1260 ("scm\\|guile" . scheme-mode) 1241 ("scm" . scheme-mode)
1261 ("emacs" . emacs-lisp-mode)
1262 ("make" . makefile-mode)
1263 ("^:" . sh-mode)) 1242 ("^:" . sh-mode))
1264 "Alist mapping interpreter names to major modes. 1243 "Alist mapping interpreter names to major modes.
1265 This alist is used to guess the major mode of a file based on the 1244 This alist is used to guess the major mode of a file based on the
1266 contents of the first line. This line often contains something like: 1245 contents of the first line. This line often contains something like:
1267 #!/bin/sh 1246 #!/bin/sh
1357 (setq mode (cdr (car alist))) 1336 (setq mode (cdr (car alist)))
1358 (setq alist nil)) 1337 (setq alist nil))
1359 (setq alist (cdr alist))))))) 1338 (setq alist (cdr alist)))))))
1360 (if mode 1339 (if mode
1361 (if (not (fboundp mode)) 1340 (if (not (fboundp mode))
1362 (let ((name (package-get-package-provider mode))) 1341 (progn
1363 (if name 1342 (if (or (not (boundp 'package-get-base))
1364 (message "Mode %s is not installed. Download package %s" mode name) 1343 (not package-get-base))
1365 (message "Mode %s either doesn't exist or is not a known package" mode)) 1344 (load "package-get-base"))
1366 (sit-for 2) 1345 (require 'package-get)
1367 (error "%s" mode)) 1346 (let ((name (package-get-package-provider mode)))
1347 (if name
1348 (message "Mode %s is not installed. Download package %s" mode name)
1349 (message "Mode %s either doesn't exist or is not a known package" mode))
1350 (sit-for 2)
1351 (error "%s" mode)))
1368 (unless (and just-from-file-name 1352 (unless (and just-from-file-name
1369 (or 1353 (or
1370 ;; Don't reinvoke major mode. 1354 ;; Don't reinvoke major mode.
1371 (eq mode major-mode) 1355 (eq mode major-mode)
1372 ;; Don't lose on minor modes. 1356 ;; Don't lose on minor modes.
1830 (read-file-name "Write file: " 1814 (read-file-name "Write file: "
1831 (cdr (assq 'default-directory 1815 (cdr (assq 'default-directory
1832 (buffer-local-variables))) 1816 (buffer-local-variables)))
1833 nil nil (buffer-name))) 1817 nil nil (buffer-name)))
1834 t 1818 t
1835 (if (and current-prefix-arg (featurep 'file-coding)) 1819 (if (and current-prefix-arg (featurep 'mule))
1836 (read-coding-system "Coding system: ")))) 1820 (read-coding-system "Coding system: "))))
1837 (and (eq (current-buffer) mouse-grabbed-buffer) 1821 (and (eq (current-buffer) mouse-grabbed-buffer)
1838 (error "Can't write minibuffer window")) 1822 (error "Can't write minibuffer window"))
1839 (or (null filename) (string-equal filename "") 1823 (or (null filename) (string-equal filename "")
1840 (progn 1824 (progn
3292 count (1- count))) 3276 count (1- count)))
3293 (if (> count 0) 3277 (if (> count 0)
3294 filename 3278 filename
3295 (error "Apparently circular symlink path")))) 3279 (error "Apparently circular symlink path"))))
3296 3280
3297 (defcustom allow-remote-paths t
3298 "*Set this to nil if you don't want remote paths to access
3299 remote files."
3300 :type 'boolean
3301 :group 'files
3302 )
3303
3304 ;; Suggested by Michael Kifer <kifer@CS.SunySB.EDU> 3281 ;; Suggested by Michael Kifer <kifer@CS.SunySB.EDU>
3305 ;; #### This is broken. It is assumes it knows
3306 ;; about all possible remote file systsems.
3307 ;; This should be a file-name-handler-method.
3308 (defun file-remote-p (file-name) 3282 (defun file-remote-p (file-name)
3309 "Test whether FILE-NAME is looked for on a remote system." 3283 "Test whether FILE-NAME is looked for on a remote system."
3310 (cond ((not allow-remote-paths) nil) 3284 (cond ((not allow-remote-paths) nil)
3311 ((featurep 'ange-ftp) (ange-ftp-ftp-path file-name)) 3285 ((featurep 'ange-ftp) (ange-ftp-ftp-path file-name))
3312 ((fboundp 'efs-ftp-path) (efs-ftp-path file-name)) 3286 ((fboundp 'efs-ftp-path) (efs-ftp-path file-name))