/[emacs]/emacs/lisp/dos-w32.el
ViewVC logotype

Diff of /emacs/lisp/dos-w32.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.32 by eliz, Fri Jun 8 10:52:37 2001 UTC revision 1.32.8.1 by miles, Fri Apr 4 06:20:04 2003 UTC
# Line 1  Line 1 
1  ;;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms  ;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms
2    
3  ;; Copyright (C) 1996 Free Software Foundation, Inc.  ;; Copyright (C) 1996 Free Software Foundation, Inc.
4    
# Line 52  Line 52 
52                                          ; Packers                                          ; Packers
53      ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\|jar\\)$" . t)      ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\|jar\\)$" . t)
54                                          ; Unix stuff                                          ; Unix stuff
55      ("\\.tp[ulpw]$" . t)      ("\\.sx[dmicw]$" . t)               ; OpenOffice.org
56                                          ; Borland Pascal stuff      ("\\.tp[ulpw]$" . t)                ; borland Pascal stuff
57      ("[:/]tags$" . nil)      ("[:/]tags$" . nil)                 ; emacs TAGS file
                                         ; Emacs TAGS file  
58      )      )
59    "*Alist for distinguishing text files from binary files.    "*Alist for distinguishing text files from binary files.
60  Each element has the form (REGEXP . TYPE), where REGEXP is matched  Each element has the form (REGEXP . TYPE), where REGEXP is matched
# Line 124  set to the appropriate coding system, an Line 123  set to the appropriate coding system, an
123          (target)          (target)
124          (binary nil) (text nil)          (binary nil) (text nil)
125          (undecided nil) (undecided-unix nil))          (undecided nil) (undecided-unix nil))
126      (cond ((eq op 'insert-file-contents)      (cond ((eq op 'insert-file-contents)
127             (setq target (nth 1 command))             (setq target (nth 1 command))
128             ;; First check for a file name that indicates             ;; First check for a file name that indicates
129             ;; it is truly binary.             ;; it is truly binary.
# Line 158  set to the appropriate coding system, an Line 157  set to the appropriate coding system, an
157    
158  (modify-coding-system-alist 'file "" 'find-buffer-file-type-coding-system)  (modify-coding-system-alist 'file "" 'find-buffer-file-type-coding-system)
159    
160  (defun find-file-binary (filename)  (defun find-file-binary (filename)
161    "Visit file FILENAME and treat it as binary."    "Visit file FILENAME and treat it as binary."
162    (interactive "FFind file binary: ")    (interactive "FFind file binary: ")
163    (let ((file-name-buffer-file-type-alist '(("" . t))))    (let ((file-name-buffer-file-type-alist '(("" . t))))
164      (find-file filename)))      (find-file filename)))
165    
166  (defun find-file-text (filename)  (defun find-file-text (filename)
167    "Visit file FILENAME and treat it as a text file."    "Visit file FILENAME and treat it as a text file."
168    (interactive "FFind file text: ")    (interactive "FFind file text: ")
169    (let ((file-name-buffer-file-type-alist '(("" . nil))))    (let ((file-name-buffer-file-type-alist '(("" . nil))))
# Line 186  set to the appropriate coding system, an Line 185  set to the appropriate coding system, an
185        (setq buffer-file-type (eq buffer-file-coding-system 'no-conversion)))))        (setq buffer-file-type (eq buffer-file-coding-system 'no-conversion)))))
186    
187  ;;; To set the default coding system on new files.  ;;; To set the default coding system on new files.
188  (add-hook 'find-file-not-found-hooks  (add-hook 'find-file-not-found-hooks
189            'find-file-not-found-set-buffer-file-coding-system)            'find-file-not-found-set-buffer-file-coding-system)
190    
191  ;;; To accomodate filesystems that do not require CR/LF translation.  ;;; To accomodate filesystems that do not require CR/LF translation.
192  (defvar untranslated-filesystem-list nil  (defvar untranslated-filesystem-list nil
193    "List of filesystems that require no CR/LF translation when reading    "List of filesystems that require no CR/LF translation when reading
194  and writing files.  Each filesystem in the list is a string naming  and writing files.  Each filesystem in the list is a string naming
195  the directory prefix corresponding to the filesystem.")  the directory prefix corresponding to the filesystem.")
196    
197  (defun untranslated-canonical-name (filename)  (defun untranslated-canonical-name (filename)
198    "Return FILENAME in a canonicalized form for use with the functions    "Return FILENAME in a canonicalized form for use with the functions
199  dealing with untranslated filesystems."  dealing with untranslated filesystems."
200    (if (memq system-type '(ms-dos windows-nt))    (if (memq system-type '(ms-dos windows-nt cygwin))
201        ;; The canonical form for DOS/W32 is with A-Z downcased and all        ;; The canonical form for DOS/W32 is with A-Z downcased and all
202        ;; directory separators changed to directory-sep-char.        ;; directory separators changed to directory-sep-char.
203        (let ((name nil))        (let ((name nil))
204          (setq name (mapconcat          (setq name (mapconcat
205                      '(lambda (char)                      '(lambda (char)
206                         (if (and (<= ?A char) (<= char ?Z))                         (if (and (<= ?A char) (<= char ?Z))
207                             (char-to-string (+ (- char ?A) ?a))                             (char-to-string (+ (- char ?A) ?a))
208                           (char-to-string char)))                           (char-to-string char)))
# Line 219  dealing with untranslated filesystems." Line 218  dealing with untranslated filesystems."
218      filename))      filename))
219    
220  (defun untranslated-file-p (filename)  (defun untranslated-file-p (filename)
221    "Return t if FILENAME is on a filesystem that does not require    "Return t if FILENAME is on a filesystem that does not require
222  CR/LF translation, and nil otherwise."  CR/LF translation, and nil otherwise."
223    (let ((fs (untranslated-canonical-name filename))    (let ((fs (untranslated-canonical-name filename))
224          (ufs-list untranslated-filesystem-list)          (ufs-list untranslated-filesystem-list)
# Line 233  CR/LF translation, and nil otherwise." Line 232  CR/LF translation, and nil otherwise."
232  (defun add-untranslated-filesystem (filesystem)  (defun add-untranslated-filesystem (filesystem)
233    "Add FILESYSTEM to the list of filesystems that do not require    "Add FILESYSTEM to the list of filesystems that do not require
234  CR/LF translation.  FILESYSTEM is a string containing the directory  CR/LF translation.  FILESYSTEM is a string containing the directory
235  prefix corresponding to the filesystem.  For example, for a Unix  prefix corresponding to the filesystem.  For example, for a Unix
236  filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."  filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
237    ;; We use "D", not "f", to avoid confusing the user: "f" prompts    ;; We use "D", not "f", to avoid confusing the user: "f" prompts
238    ;; with a directory, but RET returns the current buffer's file, not    ;; with a directory, but RET returns the current buffer's file, not
# Line 246  filesystem mounted on drive Z:, FILESYST Line 245  filesystem mounted on drive Z:, FILESYST
245              (cons fs untranslated-filesystem-list)))))              (cons fs untranslated-filesystem-list)))))
246    
247  (defun remove-untranslated-filesystem (filesystem)  (defun remove-untranslated-filesystem (filesystem)
248    "Remove FILESYSTEM from the list of filesystems that do not require    "Remove FILESYSTEM from the list of filesystems that do not require
249  CR/LF translation.  FILESYSTEM is a string containing the directory  CR/LF translation.  FILESYSTEM is a string containing the directory
250  prefix corresponding to the filesystem.  For example, for a Unix  prefix corresponding to the filesystem.  For example, for a Unix
251  filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."  filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
252    (interactive "fUntranslated file system: ")    (interactive "fUntranslated file system: ")
253    (setq untranslated-filesystem-list    (setq untranslated-filesystem-list
254          (delete (untranslated-canonical-name filesystem)          (delete (untranslated-canonical-name filesystem)
255                  untranslated-filesystem-list)))                  untranslated-filesystem-list)))
256    

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.32.8.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26