;;; emx-patch.el --- override parts of files.el etc. for emx.

;; Copyright (C) 1992-1994 Eberhard Mattes

;; Author: Eberhard Mattes <mattes@azu.informatik.uni-stuttgart.de>
;; Keywords: emx

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Code:

(require 'cp850)
(require 'emx-keys)

(defconst emx-emacs-version
  1
  "Last (third) version number of this port of Emacs for emx.")

(defun emx-add-binary-mode (regex)
  (interactive "sUse binary mode for file names matching regexp: ")
  (or (member regex emx-binary-mode-list)
      (setq emx-binary-mode-list
            (append emx-binary-mode-list (list regex)))))

(defun emx-remove-binary-mode (regex)
  (interactive "sRemove entry in emx-binary-mode-alist: ")
  (setq emx-binary-mode-list (delete regex emx-binary-mode-list)))

(emx-add-binary-mode "\\.elc$")
(emx-add-binary-mode "\\.tar$")
(emx-add-binary-mode "\\.gz$")
(emx-add-binary-mode "\\.[zZ]$")

;;
;; HPFS is case-insensitive and case-preserving
;;
(setq completion-ignore-case t)

(nconc completion-ignored-extensions
       '(".com" ".exe" ".dll" ".obj" ".bak" ".ico"
         ".zip" ".zoo" ".arj" ".lzh"))

(defun replace-char-in-string (str c1 c2)
  "Replace in string STR character C1 with character C2 and return STR.
This function does *not* copy the string."
  (let ((indx 0) (len (length str)) chr)
    (while (< indx len)
      (setq chr (aref str indx))
      (if (eq chr c1)
          (aset str indx c2))
      (setq indx (1+ indx)))
    str))

(defun make-legal-file-name (fn)
  "Turn FN into a legal file name and return the modified copy of the string.
The characters * and ? will be replaced with _."
  (setq fn (copy-sequence fn))
  (replace-char-in-string fn ?* ?_)
  (replace-char-in-string fn ?? ?_))

;;
;; Changes:
;; - replace * and ? with _
;; - on FAT file system, append # to extension
;;
(defun make-auto-save-file-name ()
  "Return file name to use for auto-saves of current buffer.
Does not consider `auto-save-visited-file-name' as that variable is checked
before calling this function.  This has been redefined for customization.
See also `auto-save-file-name-p'."
  (let ((tem
	 (if buffer-file-name
	     (concat (file-name-directory buffer-file-name)
		     "#"
		     (file-name-nondirectory buffer-file-name)
		     "#")
	   (expand-file-name (concat "#%" (make-legal-file-name 
					   (buffer-name)) "#")))))
    (cond ((file-name-valid-p tem) tem)
	  (buffer-file-name
	   (add-to-fat-file-name "#" buffer-file-name "#"))
	  (t (expand-file-name (add-to-fat-file-name "#%"
				(make-legal-file-name (buffer-name)) "#"))))))

(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."
  (let (backup)
    (or
     (progn (setq backup (concat file "~")) (file-name-valid-p backup))
     (setq backup (add-to-fat-file-name nil file "~")))
    backup))

(defun split-file-name (name)
  "Split NAME into directory part, base name part and extension.
Return a list containing three elements. If a part is empty, the list element
is nil."
  (save-match-data
    (let* ((dir (file-name-directory name))
           (file (file-name-nondirectory name))
           (pos (string-match "\\.[^.]*$" file))
           (base (if pos (substring file 0 pos) file))
           (ext (if pos (substring file pos) nil)))
      (list dir base ext))))

(defun add-to-fat-file-name (prefix file suffix)
  "Concatenate PREFIX, FILE and SUFFIX, then make it FAT compatible.
It is assumed that FILE is already compatible with the FAT file system."
  (let* ((split (split-file-name file))
	 (base (concat prefix (nth 1 split)))
	 (ext (nth 2 split))
	 (ext-len (length ext))
	 (suffix-len (length suffix)))
    (if (> (length base) 8)
	(setq base (substring base 0 8)))
    (while (and (> suffix-len 0) (eq (elt suffix 0) ?.))
      (setq suffix-len (1- suffix-len))
      (setq suffix (substring suffix 1)))
    (if (> suffix-len 3)
        (progn (setq suffix-len 3)
               (setq suffix (substring suffix 0 3))))
    (if (zerop suffix-len)
	file
      (cond ((null ext) (setq ext (concat "." suffix)))
	    ((<= (+ ext-len suffix-len) 4)
	     (setq ext (concat ext suffix)))
	    (t (setq ext (concat "." (substring ext 1
						(- 4 suffix-len)) suffix))))
      (concat (car split) base ext))))

(defun find-file-binary (filename)
  "Edit binary file FILENAME.
Switch to a buffer visiting binary file FILENAME,
creating one if none already exists."
  (interactive "FFind binary file: ")
  (let ((emx-binary-mode-list '(".*"))
        (buf (find-file filename)))
    ;; Force emx-binary-mode to t.  This is required for these cases:
    ;; - the buffer already exists
    ;; - the file does not exist
    (setq emx-binary-mode t)
    buf))

;;
;; dired
;;
(defun emx-dired-kur-ls-setup ()
  "Customize dired to Kai Uwe Rommel's ls for OS/2."
  (setq dired-re-exe
        (concat dired-re-maybe-mark dired-re-inode-size "[-r][-w]x"))
  (setq dired-re-perm-bits
        "\\([^ ]\\)[-r][-w]\\([^ ]\\)\\([-a]\\)\\([-h]\\)[-s]"))

(setq min-skip-run 2)

;;
;; Utility function for setting up AUC-TeX
;;
(defun emx-make-TeX-command (cmd)
  "Build a command which runs TeX with arguments CMD.
Prefix CMD with the value of `emx-TeX-command', inserting the cmd.exe
escape character `^' if TeX-Shell equals \"cmd.exe\" and the first
non-option word of CMD starts with `&'."
  (if (and (string-match "\\(^\\|[:/\\\\]\\)\\(cmd\\|4os2\\)\\(\\|\\.exe\\)$"
                         TeX-shell)
           (string-match "^\\(\\([-/][^ \t]+[ \t]+\\)*\\)&" cmd))
      (concat emx-TeX-command
              " " (substring cmd (match-beginning 1) (match-end 1))
              "^" (substring cmd (match-end 1)))
    (concat emx-TeX-command " " cmd)))

;;
;; shell.el: don't pass "-i" to cmd.exe
;; (This could also be done with a program name handler)
;;
(setq explicit-cmd.exe-args nil)

;;
;; sendmail.el: Use this instead of "/usr/bin/sendmail"
;; (This replacement could also be done with a program name handler)
;;
(setq sendmail-program "sendmail.exe")

;;
;; Special handling of certain programs for call-process and start-process.
;; Before applying the regexps, the file name has been translated to
;; lower case and backslashes have been replaced by forward slashes.
;;
(setq program-name-handler-alist
      '(("\\(^\\|[:/]\\)\\(cmd\\|4os2\\)\\(\\|\\.exe\\)$" . pnh-cmdproc)
        ("\\(^\\|[:/]\\)\\(command\\|4dos\\)\\(\\|\\.com\\)$" . pnh-cmdproc)
        ("\\(^\\|[:/]\\)\\(sh\\|bash\\)\\(\\|\\.exe\\)$" . pnh-shell)
        ("\\(^\\|[:/]\\)gzip\\(\\|\\.exe\\)$" . pnh-gzip)
        ("\\(^\\|[:/]\\)gunzip\\(\\|\\.exe\\)$" . pnh-gunzip)
        ("\\(^\\|[:/]\\)compress\\(\\|\\.exe\\)$" . pnh-compress)
        ("\\(^\\|[:/]\\)uncompress\\(\\|\\.exe\\)$" . pnh-uncompress)
        ("\\(^\\|[:/]\\)tcp\\(\\|\\.exe\\)$" . pnh-tcp)
        ("\\(^\\|[:/]\\)sendmail\\(\\|\\.exe\\)$" . pnh-sendmail)))

(defvar shell-command-handler-alist
  '(("gzip" . sch-gzip)
    ("gunzip" . sch-gunzip)
    ("compress" . sch-compress)
    ("uncompress" . sch-uncompress))
  "*Alist of elements (NAME . HANDLER) for shell commands handled specially.
If the base name of a shell command is equal to NAME, then HANDLER is
called by pnhc-shell-command.  The handler receives six arguments:
a list consisting of the primitive and its additional arguments (see
program-name-handler-alist for details); the file name of the shell;
the program name handler; the complete shell command; the substring
of the shell command preceding the program name; and the substring
of the shell command following the program name.")

(defvar pnh-shell-pre-processor-alist
  '()
  "*Alist of elements (REGEXP . FUNCTION) for pre-processing shell commands.
If a shell command matches REGEXP, then FUNCTION is called by
pnhc-shell-command.  The function receives one argument, the shell command.
The function returns the pre-processed shell command.
This variable is used for shells handled by pnh-shell.")

(defvar pnh-cmdproc-pre-processor-alist
  '(("^exec[ \t]+" . pnh-cmdproc-pre-exec))
  "*Alist of elements (REGEXP . FUNCTION) for pre-processing shell commands.
If a shell command matches REGEXP, then FUNCTION is called by
pnhc-shell-command.  The function receives one argument, the shell command.
The function returns the pre-processed shell command.
This variable is used for shells handled by pnh-cmdproc.")

(defvar pnh-shell-post-processor-alist
  '()
  "*Alist of elements (REGEXP . FUNCTION) for post-processing shell commands.
If a shell command matches REGEXP, then FUNCTION is called by
pnhc-shell-command.  The function receives one argument, the shell command.
The function returns the post-processed shell command.
This variable is used for shells handled by pnh-shell.")

(defvar pnh-cmdproc-post-processor-alist
  '(("^[^ \t]*/" . pnh-cmdproc-post-slash))
  "*Alist of elements (REGEXP . FUNCTION) for post-processing shell commands.
If a shell command matches REGEXP, then FUNCTION is called by
pnhc-shell-command.  The function receives one argument, the shell command.
The function returns the post-processed shell command.
This variable is used for shells handled by pnh-cmdproc.")

(defvar tcp-binary-process-input-services
  '("nntp" "119")
  "*List of services for which binary-process-input should be set to t.
The elements are service names or port numbers, as strings.")

(defvar tcp-binary-process-output-services
  '("nntp" "119")
  "*List of services for which binary-process-output should be set to t.
The elements are service names or port numbers, as strings.")

;;
;; Helper function for invoking the primitive for which a program
;; name handler was called.  HANDLER is a handler or a list of handlers
;; to be disabled temporarily
;;
(defun pnh-primitive (operation program args handler)
  (let ((inhibit-program-name-handlers
         (funcall (if (consp handler) 'append 'cons)
                  handler inhibit-program-name-handlers))
        (primitive (car operation)))
    (cond ((eq primitive 'call-process)
           ;; Invoke call-process
           (apply 'call-process program
                  (nth 1 operation) (nth 2 operation) (nth 3 operation)
                  args))
          ((eq primitive 'start-process)
           ;; Invoke start-process
           (apply 'start-process
                  (nth 1 operation) (nth 2 operation)
                  program args))
          ((eq primitive 'pnh-test)
           ;; Testing, see emx-test.el
	   (funcall 'pnh-test operation program args handler))
          (t
           ;; Error
           (error "Invalid operation passed to pnh-primitive")))))

;;
;; Program name handler for OS/2 and MS-DOS command processors
;;
(defun pnh-cmdproc (operation program args)
  (if (and (car args) (string= (car args) "-c") (eq (length args) 2))
      (pnhc-shell-command operation program 'pnh-cmdproc (nth 1 args))
  (pnh-primitive operation program args 'pnh-cmdproc)))

;;
;; Program name handler for Unix shells
;;
(defun pnh-shell (operation program args)
  (if (string= program "/bin/sh")
      (setq program "sh.exe"))
  (if (and (car args) (string= (car args) "-c") (eq (length args) 2))
      (pnhc-shell-command operation program 'pnh-shell (nth 1 args))
    (pnh-primitive operation program args 'pnh-shell)))

;; Program name handler for tcp
;; Set binary-process-input to t, if the service is listed in
;; tcp-binary-process-input-services; to nil, otherwise
;; Set binary-process-output to t, if the service is listed in
;; tcp-binary-process-output-services; to nil, otherwise

(defun pnh-tcp (operation program args)
  (let* ((service (or (nth 1 args) "nntp"))
         (binary-process-input (member service
                                       tcp-binary-process-input-services))
         (binary-process-output (member service
                                        tcp-binary-process-output-services)))
    (pnh-primitive operation program args 'pnh-tcp)))

;;
;; Program name handler for sendmail of IBM TPC/IP 2.0
;; Remove -oA and the following argument
;; Remove arguments starting with -o
;;
(defun pnh-sendmail (operation program args)
  (let (arg newargs)
    (save-match-data
      (while (consp args)
        (setq arg (car args))
        (setq args (cdr args))
        (cond ((string= arg "-oA")
               (setq args (cdr args)))
              ((string-match "^-o" arg))
              (t
               (setq newargs (append newargs (list arg))))))
      (pnh-primitive operation program newargs 'pnh-sendmail))))

;; Program name handler for gzip
;; Set binary-process-input to t, if "-d" is used
;; Set binary-process-output to t, otherwise

(defun pnh-gzip (operation program args)
  (let ((tail args)
        arg decompress binary-process-input binary-process-output)
    (save-match-data
      (while (and (not decompress)
                  (consp tail)
                  (setq arg (car tail))
                  (string-match "^-" arg))
        (if (string-match "^-d" arg)
            (setq decompress t))
        (setq tail (cdr tail))))
    (setq binary-process-input decompress)
    (setq binary-process-output (not decompress))
    (pnh-primitive operation program args 'pnh-gzip)))

;; Program name handler for gunzip
;; Run "gzip -d" instead of "gunzip"
;; pnh-gzip will set binary-process-input to t

(defun pnh-gunzip (operation program args)
  (pnh-primitive operation
                 (concat (file-name-directory program) "gzip.exe")
                 (cons "-d" args)
                 'pnh-gunzip))

;; Program name handler for compress
;; Set binary-process-input to t, if "-d" is used
;; Set binary-process-output to t, otherwise

(defun pnh-compress (operation program args)
  (let ((tail args)
        arg decompress binary-process-input binary-process-output)
    (save-match-data
      (while (and (not decompress)
                  (consp tail)
                  (setq arg (car tail))
                  (string-match "^-" arg))
        (if (string-match "^-d" arg)
            (setq decompress t))
        (setq tail (cdr tail))))
    (setq binary-process-input decompress)
    (setq binary-process-output (not decompress))
    (pnh-primitive operation program args 'pnh-compress)))

;; Program name handler for uncompress
;; Run "compress -d" instead of "uncompress"
;; pnh-compress will set binary-process-input to t

(defun pnh-uncompress (operation program args)
  (pnh-primitive operation
                 (concat (file-name-directory program) "compress.exe")
                 (cons "-d" args)
                 'pnh-uncompress))

;;
;; Helper function for invoking the primitive for which a shell command
;; handler was called
;;
(defun pnhc-shell-primitive (operation program handler command)
  (let (alist tail)
    ;; Call post-processors
    (save-match-data
      (setq alist (intern (concat (symbol-name handler)
                                  "-post-processor-alist")))
      (setq tail (and (boundp alist) (eval alist)))
      (while (consp tail)
        (if (string-match (car (car tail)) command)
            (setq command (funcall (cdr (car tail)) command)))
        (setq tail (cdr tail))))
    (if (eq handler 'pnh-shell)
        (pnh-primitive operation program (list "-c" command) handler)
      (pnh-primitive operation program (list "/c" command) handler))))

;;
;; Handle shell commands for pnh-cmdproc and pnh-shell,
;; according to shell-command-handler-alist
;;
(defun pnhc-shell-command (operation program handler command)
  (let (tail cmd-handler alist)
    (save-match-data
      ;; Call pre-processors
      (setq alist (intern (concat (symbol-name handler)
                                  "-pre-processor-alist")))
      (setq tail (and (boundp alist) (eval alist)))
      (while (consp tail)
        (if (string-match (car (car tail)) command)
            (setq command (funcall (cdr (car tail)) command)))
        (setq tail (cdr tail)))
      ;; Extract the name of the program to be run
      (if (string-match
           (concat
            "^\\(\\|exec[ \t]+\\)"        ; Optional "exec " at beginning
            "\\(\\|[^ \t<>;&|\"']*[:/\\\\]\\)" ; Optional directory
            "\\(\\("                      ; Sub-regexps 3 and 4
            "[^. \t<>;&:/\\\\()\"']+"     ; The base name
            "\\)"                         ; End of sub-regexp 4
            "\\(\\|\\.exe\\)"             ; Optional ".exe" suffix
            "\\)"                         ; End of sub-regexp 3
            "\\($\\|[ \t]\\)"             ; End of shell argument (match-end 6)
            ) command)
          (let ((prefix (substring command 0 (match-beginning 3)))
                (base-name (substring command
                                      (match-beginning 4) (match-end 4)))
                (suffix (substring command (match-end 3))))
            ;; Find the handler
            (setq tail shell-command-handler-alist)
            (while (and (consp tail) (not cmd-handler))
              (if (string= (car (car tail)) base-name)
                  (setq cmd-handler (cdr (car tail)))
                (setq tail (cdr tail))))
            ;; Call the handler
            (if (not cmd-handler)
                (pnhc-shell-primitive operation program handler command)
              (funcall cmd-handler operation program handler command
                       prefix suffix)))
        ;; The gigantic regexp above didn't match
        (pnhc-shell-primitive operation program handler command)))))

;;
;; pre-processor for pnh-cmdproc: remove "exec "
;;

(defun pnh-cmdproc-pre-exec (command)
  (substring command (match-end 0)))

;;
;; post-processor for pnh-cmdproc:
;; replace slashes with backslashes in the first word
;;

(defun pnh-cmdproc-post-slash (command)
  (setq command (copy-sequence command))
  (while (string-match "^[^ \t]*/" command)
    (aset command (1- (match-end 0)) ?\\))
  command)

;; Shell command handler for gunzip
;; Use "gzip -d" instead of "gunzip"
;; Set binary-process-input

(defun sch-gunzip (operation program handler command prefix suffix)
  (let ((binary-process-input t))
    (pnhc-shell-primitive operation program handler
                          (concat prefix "gzip.exe -d" suffix))))

;; Shell command handler for gzip
;; Set binary-process-input or binary-process-output

(defun sch-gzip (operation program handler command prefix suffix)
  (let (binary-process-input binary-process-output)
    (if (string-match
         ;; "any options followed by -d"
         "^\\([ \t]+-[^ \t]+\\)*[ \t]+-d" suffix)
        (setq binary-process-input t)
      (setq binary-process-output t))
    (pnhc-shell-primitive operation program handler command)))

;; Shell command handler for uncompress
;; Use "compress -d" instead of "uncompress"
;; Set binary-process-input

(defun sch-uncompress (operation program handler command prefix suffix)
  (let ((binary-process-input t))
    (pnhc-shell-primitive operation program handler
                          (concat prefix "compress.exe -d" suffix))))

;; Shell command handler for compress
;; Set binary-input or binary-output

(defalias 'sch-compress 'sch-gzip)

;;; emx-patch.el ends here