]> code.delx.au - gnu-emacs/blobdiff - lisp/dos-w32.el
Doc fixes.
[gnu-emacs] / lisp / dos-w32.el
index 83de34749afc4296b82eac4d28289f122f77f23e..351f5bf37896809ce5af2b2a1567a41f177f2871 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1996 Free Software Foundation, Inc.
 
-;; Maintainer: Geoff Voelker (voelker@cs.washington.edu)
+;; Maintainer: Geoff Voelker <voelker@cs.washington.edu>
 ;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
 
 ;;; Code:
 
-;;; Add %t: into the mode line format just after the open-paren.
-(let ((tail (member "   %[(" mode-line-format)))
-  (setcdr tail (cons (purecopy "%t:")
-                    (cdr tail))))
-
 ;; Use ";" instead of ":" as a path separator (from files.el).
 (setq path-separator ";")
 
+(setq minibuffer-history-case-insensitive-variables
+      (cons 'file-name-history minibuffer-history-case-insensitive-variables))
+
 ;; Set the null device (for compile.el).
-(setq grep-null-device "NUL")
+(setq null-device "NUL")
 
 ;; Set the grep regexp to match entries with drive letters.
 (setq grep-regexp-alist
   '(
     ("[:/].*config.sys$" . nil)                ; config.sys text
     ("\\.elc$" . t)                    ; emacs stuff
-    ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
+    ("\\.\\(obj\\|exe\\|com\\|lib\\|sym\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\|class\\)$" . t)
                                        ; MS-Dos stuff
+    ("\\.\\(dll\\|drv\\|cpl\\|scr\\vbx\\|386\\|vxd\\|fon\\|fnt\\|fot\\|ttf\\|grp\\)$" . t)
+                                       ; Windows stuff
+    ("\\.\\(hlp\\|bmp\\|wav\\|avi\\|mpg\\|jpg\\|tif\\mov\\au\\)" . t)
+                                       ; known binary data files
     ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
                                        ; Packers
-    ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
+    ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\|jar\\)$" . t)
                                        ; Unix stuff
     ("\\.tp[ulpw]$" . t)
                                        ; Borland Pascal stuff
-    ("[:/]tags$" . t)
+    ("[:/]tags$" . nil)
                                        ; Emacs TAGS file
     )
   "*Alist for distinguishing text files from binary files.
 Each element has the form (REGEXP . TYPE), where REGEXP is matched
 against the file name, and TYPE is nil for text, t for binary.")
 
+;; Return the pair matching filename on file-name-buffer-file-type-alist,
+;; or nil otherwise.
+(defun find-buffer-file-type-match (filename)
+  (let ((alist file-name-buffer-file-type-alist)
+       (found nil))
+    (let ((case-fold-search t))
+      (setq filename (file-name-sans-versions filename))
+      (while (and (not found) alist)
+       (if (string-match (car (car alist)) filename)
+           (setq found (car alist)))
+       (setq alist (cdr alist)))
+      found)))
+
+;; Don't check for untranslated file systems here.
 (defun find-buffer-file-type (filename)
-  ;; First check if file is on an untranslated filesystem, then on the alist.
-  (if (untranslated-file-p filename)
-      t ; for binary
-    (let ((alist file-name-buffer-file-type-alist)
-         (found nil)
-         (code nil))
-      (let ((case-fold-search t))
-       (setq filename (file-name-sans-versions filename))
-       (while (and (not found) alist)
-         (if (string-match (car (car alist)) filename)
-             (setq code (cdr (car alist))
-                   found t))
-         (setq alist (cdr alist))))
-      (if found
-         (cond ((memq code '(nil t)) code)
-               ((and (symbolp code) (fboundp code))
-                (funcall code filename)))
-       default-buffer-file-type))))
+  (let ((match (find-buffer-file-type-match filename))
+       (code))
+    (if (not match)
+       default-buffer-file-type
+      (setq code (cdr match))
+      (cond ((memq code '(nil t)) code)
+           ((and (symbolp code) (fboundp code))
+            (funcall code filename))))))
+
+(setq-default buffer-file-coding-system 'undecided-dos)
+
+(defun find-buffer-file-type-coding-system (command)
+  "Choose a coding system for a file operation.
+If COMMAND is `insert-file-contents', the coding system is chosen based
+upon the filename, the contents of `untranslated-filesystem-list' and
+`file-name-buffer-file-type-alist', and whether the file exists:
+
+  If it matches in `untranslated-filesystem-list':
+    If the file exists:                                        `no-conversion'
+    If the file does not exist:                                `undecided'
+  If it matches in `file-name-buffer-file-type-alist':
+    If the match is t (for binary):                    `no-conversion'
+    If the match is nil (for dos-text):                        `undecided-dos'
+  Otherwise:
+    If the file exists:                                        `undecided'
+    If the file does not exist:                                `undecided-dos'
+
+If COMMAND is `write-region', the coding system is chosen based upon
+the value of `buffer-file-coding-system' and `buffer-file-type'. If
+`buffer-file-coding-system' is non-nil, its value is used.  If it is
+nil and `buffer-file-type' is t, the coding system is `no-conversion'.
+Otherwise, it is `undecided-dos'.
+
+The two most common situations are when DOS and Unix files are read
+and written, and their names do not match in
+`untranslated-filesystem-list' and `file-name-buffer-file-type-alist'.
+In these cases, the coding system initially will be `undecided'.  As
+the file is read in the DOS case, the coding system will be changed to
+`undecided-dos' as CR/LFs are detected.  As the file is read in the
+Unix case, the coding system will be changed to `undecided-unix' as
+LFs are detected.  In both cases, `buffer-file-coding-system' will be
+set to the appropriate coding system, and the value of
+`buffer-file-coding-system' will be used when writing the file."
+
+  (let ((op (nth 0 command))
+       (target)
+       (binary nil) (text nil)
+       (undecided nil) (undecided-unix nil))
+    (cond ((eq op 'insert-file-contents) 
+          (setq target (nth 1 command))
+          ;; First check for a file name that indicates
+          ;; it is truly binary.
+          (setq binary (find-buffer-file-type target))
+          (cond (binary)
+                ;; Next check for files that MUST use DOS eol conversion.
+                ((find-buffer-file-type-match target)
+                 (setq text t))
+                ;; For any other existing file, decide based on contents.
+                ((file-exists-p target)
+                 (setq undecided t))
+                ;; Next check for a non-DOS file system.
+                ((untranslated-file-p target)
+                 (setq undecided-unix t)))
+          (cond (binary '(no-conversion . no-conversion))
+                (text '(undecided-dos . undecided-dos))
+                (undecided-unix '(undecided-unix . undecided-unix))
+                (undecided '(undecided . undecided))
+                (t '(undecided-dos . undecided-dos))))
+         ((eq op 'write-region)
+          (if buffer-file-coding-system
+              (cons buffer-file-coding-system
+                    buffer-file-coding-system)
+            ;; Normally this is used only in a non-file-visiting
+            ;; buffer, because normally buffer-file-coding-system is non-nil
+            ;; in a file-visiting buffer.
+            (if buffer-file-type
+                '(no-conversion . no-conversion)
+              '(undecided-dos . undecided-dos)))))))
+
+(modify-coding-system-alist 'file "" 'find-buffer-file-type-coding-system)
 
 (defun find-file-binary (filename) 
   "Visit file FILENAME and treat it as binary."
@@ -96,15 +174,18 @@ against the file name, and TYPE is nil for text, t for binary.")
   (let ((file-name-buffer-file-type-alist '(("" . nil))))
     (find-file filename)))
 
-(defun find-file-not-found-set-buffer-file-type ()
+(defun find-file-not-found-set-buffer-file-coding-system ()
   (save-excursion
     (set-buffer (current-buffer))
-    (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
-  nil)
-
-;;; To set the default file type on new files.
-(add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
+    (let* ((dummy-insert-op (list 'insert-file-contents (buffer-file-name)))
+          (coding-system-pair
+           (find-buffer-file-type-coding-system dummy-insert-op)))
+      (setq buffer-file-coding-system (car coding-system-pair))
+      (setq buffer-file-type (eq buffer-file-coding-system 'no-conversion)))))
 
+;;; To set the default coding system on new files.
+(add-hook 'find-file-not-found-hooks 
+         'find-file-not-found-set-buffer-file-coding-system)
 
 ;;; To accomodate filesystems that do not require CR/LF translation.
 (defvar untranslated-filesystem-list nil
@@ -116,7 +197,7 @@ the directory prefix corresponding to the filesystem.")
   "Return FILENAME in a canonicalized form for use with the functions
 dealing with untranslated filesystems."
   (if (memq system-type '(ms-dos windows-nt))
-      ;; The canonical form for DOS/NT/Win95 is with A-Z downcased and all
+      ;; The canonical form for DOS/W32 is with A-Z downcased and all
       ;; directory separators changed to directory-sep-char.
       (let ((name nil))
        (setq name (mapconcat 
@@ -149,6 +230,7 @@ CR/LF translation, and nil otherwise."
 CR/LF translation.  FILESYSTEM is a string containing the directory
 prefix corresponding to the filesystem.  For example, for a Unix 
 filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
+  (interactive "fUntranslated file system: ")
   (let ((fs (untranslated-canonical-name filesystem)))
     (if (member fs untranslated-filesystem-list)
        untranslated-filesystem-list
@@ -160,10 +242,72 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
 CR/LF translation.  FILESYSTEM is a string containing the directory
 prefix corresponding to the filesystem.  For example, for a Unix 
 filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
+  (interactive "fUntranslated file system: ")
   (setq untranslated-filesystem-list 
        (delete (untranslated-canonical-name filesystem)
                untranslated-filesystem-list)))
 
+(setq-default default-process-coding-system
+             (if (fboundp 'start-process)
+                 '(raw-text-dos . raw-text-dos)
+               '(undecided-dos . undecided-dos)))
+
+;; Support for printing under DOS/Windows, see lpr.el and ps-print.el.
+(defvar printer-name)
+
+(defun direct-print-region-function (start end
+                                          &optional lpr-prog
+                                          delete-text buf display
+                                          &rest rest)
+  "DOS/Windows-specific function to print the region on a printer.
+Writes the region to the device or file which is a value of
+`printer-name' \(which see\).  Ignores any arguments beyond
+START and END."
+
+  ;; DOS printers need the lines to end with CR-LF pairs, so make
+  ;; sure it always happens that way, unless the buffer is binary.
+  (let* ((coding coding-system-for-write)
+        (coding-base
+         (if (null coding) 'undecided (coding-system-base coding)))
+        (eol-type (coding-system-eol-type coding-base)))
+    (or (eq coding-system-for-write 'no-conversion)
+       (setq coding-system-for-write
+             (aref eol-type 1)))       ; force conversion to DOS EOLs
+    (write-region start end
+                 (or (and (boundp 'dos-printer) dos-printer)
+                     printer-name)
+                 t 0)
+    ;; Make each print-out start on a new page, but don't waste
+    ;; paper if there was a form-feed at the end of this file.
+    (if (not (char-equal (char-after (1- end)) ?\C-l))
+       (write-region "\f" nil
+                     (or (and (boundp 'dos-printer) dos-printer)
+                         printer-name)
+                     t 0))))
+
+;; Set this to nil if you have a port of the `lpr' program and
+;; you want to use it for printing.  If the default setting is
+;; in effect, `lpr-command' and its switches are ignored when
+;; printing with `lpr-xxx' and `print-xxx'.
+(setq print-region-function 'direct-print-region-function)
+
+;; Set this to nil if you have a port of the `pr' program
+;; (e.g., from GNU Textutils), or if you have an `lpr'
+;; program (see above) that can print page headers.
+;; If `lpr-headers-switches' is non-nil (the default) and
+;; `print-region-function' is set to `dos-print-region-function',
+;; then requests to print page headers will be silently
+;; ignored, and `print-buffer' and `print-region' produce
+;; the same output as `lpr-buffer' and `lpr-region', accordingly.
+(setq lpr-headers-switches "(page headers are not supported)")
+
+(defvar ps-printer-name)
+
+(setq ps-lpr-command "gs")
+
+(setq ps-lpr-switches '("-q" "-dNOPAUSE" "-sDEVICE=epson" "-r240x60"
+                         "-sOutputFile=LPT1" "-"))
+
 (provide 'dos-w32)
 
 ;;; dos-w32.el ends here