]> code.delx.au - gnu-emacs/commitdiff
Cleanup namespace of dos-w32.el.
authorStefan Monnier <monnier@iro.umontreal.ca>
Wed, 30 Oct 2013 02:45:53 +0000 (22:45 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Wed, 30 Oct 2013 02:45:53 +0000 (22:45 -0400)
* lisp/dos-w32.el (minibuffer-history-case-insensitive-variables)
(path-separator, null-device, buffer-file-coding-system)
(lpr-headers-switches): Check system-type before modifying them.
(find-buffer-file-type-coding-system): Mark obsolete.
(w32-find-file-not-found-set-buffer-file-coding-system): Rename from
find-file-not-found-set-buffer-file-coding-system.
(w32-untranslated-filesystem-list, w32-untranslated-canonical-name):
(w32-add-untranslated-filesystem, w32-remove-untranslated-filesystem)
(w32-direct-print-region-use-command-dot-com, w32-untranslated-file-p):
(w32-direct-print-region-helper, w32-direct-print-region-function)
(w32-direct-ps-print-region-function): Rename by adding a "w32-" prefix.
* lisp/startup.el (normal-top-level-add-subdirs-to-load-path):
* lisp/ps-print.el (ps-print-region-function):
* lisp/lpr.el (print-region-function): Use new name.

* lisp/simple.el (copy-region-as-kill): Fix call to region-extract-function.

* lisp/emacs-lisp/bytecomp.el (byte-defop-compiler): Add new `2-and' handler.
(byte-compile-and-folded): New function.
(=, <, >, <=, >=): Use it.

lisp/ChangeLog
lisp/dos-w32.el
lisp/emacs-lisp/bytecomp.el
lisp/lpr.el
lisp/ps-print.el
lisp/simple.el
lisp/startup.el
src/insdel.c

index d2c99e75f561c08400d1ed64f815980c1f6521d5..a0cf681dcea8cc9563dbd9cc57421d96d3dd0dee 100644 (file)
@@ -1,5 +1,26 @@
 2013-10-30  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * simple.el (copy-region-as-kill): Fix call to region-extract-function.
+
+       * emacs-lisp/bytecomp.el (byte-defop-compiler): Add new `2-and' handler.
+       (byte-compile-and-folded): New function.
+       (=, <, >, <=, >=): Use it.
+
+       * dos-w32.el (minibuffer-history-case-insensitive-variables)
+       (path-separator, null-device, buffer-file-coding-system)
+       (lpr-headers-switches): Check system-type before modifying them.
+       (find-buffer-file-type-coding-system): Mark obsolete.
+       (w32-find-file-not-found-set-buffer-file-coding-system): Rename from
+       find-file-not-found-set-buffer-file-coding-system.
+       (w32-untranslated-filesystem-list, w32-untranslated-canonical-name):
+       (w32-add-untranslated-filesystem, w32-remove-untranslated-filesystem)
+       (w32-direct-print-region-use-command-dot-com, w32-untranslated-file-p):
+       (w32-direct-print-region-helper, w32-direct-print-region-function)
+       (w32-direct-ps-print-region-function): Rename by adding a "w32-" prefix.
+       * startup.el (normal-top-level-add-subdirs-to-load-path):
+       * ps-print.el (ps-print-region-function):
+       * lpr.el (print-region-function): Use new name.
+
        * subr.el (custom-declare-variable-early): Remove function.
        (custom-declare-variable-list): Remove var.
        (error, user-error): Remove `while' loop.
index 0573caa6c23c1f721662d1c50fbcf64713ca987a..a556d30dc1275fd42951a13d822a209bb2f2edd3 100644 (file)
 ;;; Code:
 
 ;; 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 null-device "NUL")
+(when (memq system-type '(ms-dos windows-nt))
+  (setq path-separator ";")
+  (push 'file-name-history minibuffer-history-case-insensitive-variables)
+  ;; Set the null device (for compile.el).
+  (setq null-device "NUL")
+  (setq-default buffer-file-coding-system 'undecided-dos))
 
 ;; For distinguishing file types based upon suffixes.  DEPRECATED, DO NOT USE!
 (defcustom file-name-buffer-file-type-alist
@@ -67,18 +66,16 @@ This variable is deprecated, not used anywhere, and will soon be deleted."
                        'file-coding-system-alist
                        "24.4")
 
-(setq-default buffer-file-coding-system 'undecided-dos)
-
 (defun find-buffer-file-type-coding-system (command)
   "Choose a coding system for a file operation in COMMAND.
 COMMAND is a list that specifies the operation, an I/O primitive, as its
 CAR, and the arguments that might be given to that operation as its CDR.
 If operation is `insert-file-contents', the coding system is chosen based
 upon the filename (the CAR of the arguments beyond the operation), the contents
-of `untranslated-filesystem-list' and `file-name-buffer-file-type-alist',
+of `w32-untranslated-filesystem-list' and `file-name-buffer-file-type-alist',
 and whether the file exists:
 
-  If it matches in `untranslated-filesystem-list':
+  If it matches in `w32-untranslated-filesystem-list':
     If the file exists:                                        `undecided'
     If the file does not exist:                                `undecided-unix'
   Otherwise:
@@ -95,7 +92,7 @@ upon the value of `buffer-file-coding-system'.  If
 Otherwise, it is `undecided-dos'.
 
 The most common situation is when DOS and Unix files are read and
-written, and their names do not match in `untranslated-filesystem-list'.
+written, and their names do not match in `w32-untranslated-filesystem-list'.
 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
@@ -135,7 +132,7 @@ when writing the file."
                                           (file-name-directory target)))))
                  (setq undecided t))
                 ;; Next check for a non-DOS file system.
-                ((untranslated-file-p target)
+                ((w32-untranslated-file-p target)
                  (setq undecided-unix t)))
           (cond (undecided-unix '(undecided-unix . undecided-unix))
                 (undecided '(undecided . undecided))
@@ -149,11 +146,14 @@ when writing the file."
             ;; buffer, because normally buffer-file-coding-system is non-nil
             ;; in a file-visiting buffer.
             '(undecided-dos . undecided-dos))))))
+(make-obsolete 'find-buffer-file-type-coding-system nil "24.4")
 
 (defun find-file-binary (filename)
   "Visit file FILENAME and treat it as binary."
+  ;; FIXME: Why here rather than in files.el?
+  ;; FIXME: Can't we use find-file-literally for the same purposes?
   (interactive "FFind file binary: ")
-  (let ((coding-system-for-read 'no-conversion))
+  (let ((coding-system-for-read 'no-conversion))  ;; FIXME: undecided-unix?
     (find-file filename)))
 
 (defun find-file-text (filename)
@@ -162,7 +162,7 @@ when writing the file."
   (let ((coding-system-for-read 'undecided-dos))
     (find-file filename)))
 
-(defun find-file-not-found-set-buffer-file-coding-system ()
+(defun w32-find-file-not-found-set-buffer-file-coding-system ()
   (with-current-buffer (current-buffer)
     (let ((coding buffer-file-coding-system))
       ;; buffer-file-coding-system is already set by
@@ -171,49 +171,50 @@ when writing the file."
       ;; the EOL conversion, if required by the user.
       (when (and (null coding-system-for-read)
                 (or inhibit-eol-conversion
-                    (untranslated-file-p (buffer-file-name))))
+                    (w32-untranslated-file-p (buffer-file-name))))
        (setq coding (coding-system-change-eol-conversion coding 0))
        (setq buffer-file-coding-system coding))
       nil)))
 
-;;; To set the default coding system on new files.
+;; To set the default coding system on new files.
 (add-hook 'find-file-not-found-functions
-         'find-file-not-found-set-buffer-file-coding-system)
+         'w32-find-file-not-found-set-buffer-file-coding-system)
 
 ;;; To accommodate filesystems that do not require CR/LF translation.
-(defvar untranslated-filesystem-list nil
+(define-obsolete-variable-alias 'untranslated-filesystem-list
+  'w32-untranslated-filesystem-list "24.4")
+(defvar w32-untranslated-filesystem-list nil
   "List of filesystems that require no CR/LF translation when reading
 and writing files.  Each filesystem in the list is a string naming
 the directory prefix corresponding to the filesystem.")
 
-(defun untranslated-canonical-name (filename)
+(defun w32-untranslated-canonical-name (filename)
   "Return FILENAME in a canonicalized form for use with the functions
 dealing with untranslated filesystems."
   (if (memq system-type '(ms-dos windows-nt cygwin))
       ;; 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
-                   (lambda (char)
-                      (if (and (<= ?A char) (<= char ?Z))
-                          (char-to-string (+ (- char ?A) ?a))
-                        (char-to-string char)))
-                   filename nil))
+      (let ((name
+             (mapconcat (lambda (char)
+                          (char-to-string (if (and (<= ?A char ?Z))
+                                              (+ (- char ?A) ?a)
+                                            char)))
+                        filename nil)))
        ;; Use expand-file-name to canonicalize directory separators, except
        ;; with bare drive letters (which would have the cwd appended).
        ;; Avoid expanding names that could trigger ange-ftp to prompt
        ;; for passwords, though.
-       (if (or (string-match-p "^.:$" name)
+       (if (or (string-match-p "^.:\\'" name)
                (string-match-p "^/[^/:]+:" name))
            name
          (expand-file-name name)))
     filename))
 
-(defun untranslated-file-p (filename)
+(defun w32-untranslated-file-p (filename)
   "Return t if FILENAME is on a filesystem that does not require
 CR/LF translation, and nil otherwise."
-  (let ((fs (untranslated-canonical-name filename))
-       (ufs-list untranslated-filesystem-list)
+  (let ((fs (w32-untranslated-canonical-name filename))
+       (ufs-list w32-untranslated-filesystem-list)
        (found nil))
     (while (and (not found) ufs-list)
       (if (string-match-p (concat "^" (car ufs-list)) fs)
@@ -221,7 +222,9 @@ CR/LF translation, and nil otherwise."
        (setq ufs-list (cdr ufs-list))))
     found))
 
-(defun add-untranslated-filesystem (filesystem)
+(define-obsolete-function-alias 'add-untranslated-filesystem
+  'w32-add-untranslated-filesystem "24.4")
+(defun w32-add-untranslated-filesystem (filesystem)
   "Add FILESYSTEM to the list of filesystems that do not require
 CR/LF translation.  FILESYSTEM is a string containing the directory
 prefix corresponding to the filesystem.  For example, for a Unix
@@ -230,25 +233,29 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
   ;; with a directory, but RET returns the current buffer's file, not
   ;; its directory.
   (interactive "DUntranslated file system: ")
-  (let ((fs (untranslated-canonical-name filesystem)))
-    (if (member fs untranslated-filesystem-list)
-       untranslated-filesystem-list
-      (setq untranslated-filesystem-list
-           (cons fs untranslated-filesystem-list)))))
+  (let ((fs (w32-untranslated-canonical-name filesystem)))
+    (if (member fs w32-untranslated-filesystem-list)
+       w32-untranslated-filesystem-list
+      (push fs w32-untranslated-filesystem-list))))
+
 
-(defun remove-untranslated-filesystem (filesystem)
+(define-obsolete-function-alias 'remove-untranslated-filesystem
+  'w32-remove-untranslated-filesystem "24.4")
+(defun w32-remove-untranslated-filesystem (filesystem)
   "Remove FILESYSTEM from the list of filesystems that do not require
 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 w32-untranslated-filesystem-list
+       (delete (w32-untranslated-canonical-name filesystem)
+               w32-untranslated-filesystem-list)))
 
 ;;; Support for printing under DOS/Windows, see lpr.el and ps-print.el.
 
-(defcustom direct-print-region-use-command-dot-com t
+(define-obsolete-variable-alias 'direct-print-region-use-command-dot-com
+  'w32-direct-print-region-use-command-dot-com "24.4")
+(defcustom w32-direct-print-region-use-command-dot-com t
   "If non-nil, use command.com to print on Windows 9x."
   :type 'boolean
   :group 'dos-fns
@@ -256,7 +263,7 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
 
 ;; Function to actually send data to the printer port.
 ;; Supports writing directly, and using various programs.
-(defun direct-print-region-helper (printer
+(defun w32-direct-print-region-helper (printer
                                    start end
                                    lpr-prog
                                    _delete-text _buf _display
@@ -332,7 +339,7 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
         ((and (eq system-type 'windows-nt)
               (getenv "winbootdir")
               ;; Allow cop-out so command.com isn't invoked
-              direct-print-region-use-command-dot-com
+              w32-direct-print-region-use-command-dot-com
               ;; file-attributes fails on LPT ports on Windows 9x but
               ;; not on NT, so handle both cases for safety.
               (eq (or (nth 7 (file-attributes printer)) 0) 0))
@@ -351,10 +358,12 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
 
 (declare-function default-printer-name "w32fns.c")
 
-(defun direct-print-region-function (start end
-                                     &optional lpr-prog
-                                     delete-text buf display
-                                     &rest rest)
+(define-obsolete-function-alias 'direct-print-region-function
+  'w32-direct-print-region-function "24.4")
+(defun w32-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), unless the value of `lpr-command'
@@ -382,8 +391,8 @@ indicates a specific program should be invoked."
     (or (eq coding-system-for-write 'no-conversion)
        (setq coding-system-for-write
              (aref eol-type 1)))       ; force conversion to DOS EOLs
-    (direct-print-region-helper printer start end lpr-prog
-                               delete-text buf display rest)))
+    (w32-direct-print-region-helper printer start end lpr-prog
+                                    delete-text buf display rest)))
 
 (defvar lpr-headers-switches)
 
@@ -395,14 +404,17 @@ indicates a specific program should be invoked."
 ;; 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)")
+(when (memq system-type '(ms-dos windows-nt))
+  (setq lpr-headers-switches "(page headers are not supported)"))
 
 (defvar ps-printer-name)
 
-(defun direct-ps-print-region-function (start end
-                                             &optional lpr-prog
-                                             delete-text buf display
-                                             &rest rest)
+(define-obsolete-function-alias 'direct-ps-print-region-function
+  'w32-direct-ps-print-region-function "24.4")
+(defun w32-direct-ps-print-region-function (start end
+                                                  &optional lpr-prog
+                                                  delete-text buf display
+                                                  &rest rest)
   "DOS/Windows-specific function to print the region on a PostScript printer.
 Writes the region to the device or file which is a value of
 `ps-printer-name' (which see), unless the value of `ps-lpr-command'
@@ -413,8 +425,8 @@ indicates a specific program should be invoked."
                          (symbol-value 'dos-ps-printer))
                     ps-printer-name
                     (default-printer-name))))
-    (direct-print-region-helper printer start end lpr-prog
-                               delete-text buf display rest)))
+    (w32-direct-print-region-helper printer start end lpr-prog
+                                    delete-text buf display rest)))
 
 ;(setq ps-lpr-command "gs")
 
index 35c7c39187055d390067319d94a7f7f28f83952e..e0d474bbb9f2f639737bc7b6df16bf05cf271cd7 100644 (file)
@@ -3175,6 +3175,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
                                      '((0 . byte-compile-no-args)
                                        (1 . byte-compile-one-arg)
                                        (2 . byte-compile-two-args)
+                                       (2-and . byte-compile-and-folded)
                                        (3 . byte-compile-three-args)
                                        (0-1 . byte-compile-zero-or-one-arg)
                                        (1-2 . byte-compile-one-or-two-args)
@@ -3256,11 +3257,11 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
 (byte-defop-compiler cons              2)
 (byte-defop-compiler aref              2)
 (byte-defop-compiler set               2)
-(byte-defop-compiler (= byte-eqlsign)  2)
-(byte-defop-compiler (< byte-lss)      2)
-(byte-defop-compiler (> byte-gtr)      2)
-(byte-defop-compiler (<= byte-leq)     2)
-(byte-defop-compiler (>= byte-geq)     2)
+(byte-defop-compiler (= byte-eqlsign)  2-and)
+(byte-defop-compiler (< byte-lss)      2-and)
+(byte-defop-compiler (> byte-gtr)      2-and)
+(byte-defop-compiler (<= byte-leq)     2-and)
+(byte-defop-compiler (>= byte-geq)     2-and)
 (byte-defop-compiler get               2)
 (byte-defop-compiler nth               2)
 (byte-defop-compiler substring         2-3)
@@ -3324,6 +3325,16 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
     (byte-compile-form (nth 2 form))
     (byte-compile-out (get (car form) 'byte-opcode) 0)))
 
+(defun byte-compile-and-folded (form)
+  "Compile calls to functions like `<='.
+These implicitly `and' together a bunch of two-arg bytecodes."
+  (let ((l (length form)))
+    (cond
+     ((< l 3) (byte-compile-form `(progn ,(nth 1 form) t)))
+     ((= l 3) (byte-compile-two-args form))
+     (t (byte-compile-form `(and (,(car form) ,(nth 1 form) ,(nth 2 form))
+                                (,(car form) ,@(nthcdr 2 form))))))))
+
 (defun byte-compile-three-args (form)
   (if (not (= (length form) 4))
       (byte-compile-subr-wrong-args form 3)
index 5aed3bcc484ba3e74e422976248970fc1cf5269b..0e96051715905fdf70423eeef24be3f1d0b253aa 100644 (file)
@@ -132,7 +132,7 @@ and print the result."
 
 (defcustom print-region-function
   (if (memq system-type '(ms-dos windows-nt))
-      #'direct-print-region-function
+      #'w32-direct-print-region-function
     #'call-process-region)
   "Function to call to print the region on a printer.
 See definition of `print-region-1' for calling conventions."
index 5ece9cb966bf2a05c70f6532222963b84836b1c9..50a447019061d2a9880387b5158084047a8a5af6 100644 (file)
@@ -1772,7 +1772,7 @@ See `ps-lpr-command'."
 
 (defcustom ps-print-region-function
   (if (memq system-type '(ms-dos windows-nt))
-      #'direct-ps-print-region-function
+      #'w32-direct-ps-print-region-function
     #'call-process-region)
   "Specify a function to print the region on a PostScript printer.
 See definition of `call-process-region' for calling conventions.  The fourth
index 49108025a4046d2473baff3daa5b36b4787adb1b..ca2088eeb24a66f5decd5fd05511dd465a5fa573 100644 (file)
@@ -3676,7 +3676,7 @@ some text between BEG and END, but we're copying the region.
 This command's old key binding has been given to `kill-ring-save'."
   (interactive "r\np")
   (let ((str (if region
-                 (funcall region-extract-function)
+                 (funcall region-extract-function nil)
                (filter-buffer-substring beg end))))
   (if (eq last-command 'kill-region)
         (kill-append str (< end beg))
index cc40f9ec8e98b3c98479243d3ed0ef3235d7fbd8..3f4923afb2e4d791fe2325732525ac2b9239f0b4 100644 (file)
@@ -441,8 +441,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
       (let* ((this-dir (car dirs))
             (contents (directory-files this-dir))
             (default-directory this-dir)
-            (canonicalized (if (fboundp 'untranslated-canonical-name)
-                               (untranslated-canonical-name this-dir))))
+            (canonicalized (if (fboundp 'w32-untranslated-canonical-name)
+                               (w32-untranslated-canonical-name this-dir))))
        ;; The Windows version doesn't report meaningful inode numbers, so
        ;; use the canonicalized absolute file name of the directory instead.
        (setq attrs (or canonicalized
index d7b7ff05e2c0038b66a7a2e20bf775f012035519..08349fffe4523c23be1c6d3b5e5a2497d5c83c50 100644 (file)
@@ -827,7 +827,7 @@ insert_1_both (const char *string,
 
   eassert (GPT <= GPT_BYTE);
 
-  /* The insert may have been in the unchanged region, so check again. */
+  /* The insert may have been in the unchanged region, so check again.  */
   if (Z - GPT < END_UNCHANGED)
     END_UNCHANGED = Z - GPT;
 
@@ -956,7 +956,7 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
 
   eassert (GPT <= GPT_BYTE);
 
-  /* The insert may have been in the unchanged region, so check again. */
+  /* The insert may have been in the unchanged region, so check again.  */
   if (Z - GPT < END_UNCHANGED)
     END_UNCHANGED = Z - GPT;
 
@@ -1148,7 +1148,7 @@ insert_from_buffer_1 (struct buffer *buf,
 
   eassert (GPT <= GPT_BYTE);
 
-  /* The insert may have been in the unchanged region, so check again. */
+  /* The insert may have been in the unchanged region, so check again.  */
   if (Z - GPT < END_UNCHANGED)
     END_UNCHANGED = Z - GPT;