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

;; Copyright (C) 1992, 1993 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)

(defun emx-add-binary-mode (regex)
  (interactive "sUse binary mode for file names matching regexp: ")
  (let ((el (cons regex 'emx-hook-function)))
    (or (member el file-name-handler-alist)
        (setq file-name-handler-alist
              (append file-name-handler-alist (list el))))))

(defun emx-hook-function (operation &rest args)
  (let ((fn (get operation 'emx)))
    (if fn (apply fn args)
      (let (file-name-handler-alist)
        (apply operation args)))))

(put 'insert-file-contents 'emx 'emx-insert-file-contents)
(put 'write-region 'emx 'emx-write-region)

(defun emx-insert-file-contents (filename &optional visit)
  (let ((emx-binary-mode t) file-name-handler-alist)
    (insert-file-contents filename visit)))

(defun emx-write-region (start end filename &optional append visit)
  (let ((emx-binary-mode t) file-name-handler-alist)
    (write-region start end filename append visit)))

(emx-add-binary-mode "\\.elc$")
(emx-add-binary-mode "\\.tar$")

;;
;; 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 ?? ?_))

(let ((i 128))
  (while (< i 256)
    (global-set-key (vector i) 'self-insert-command)
    (define-key isearch-mode-map (vector i) 'isearch-printing-char)
    (setq i (1+ i))))

;;
;; 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; that 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."
  (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))))

;;
;; 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)

;;; emx-patch.el ends here
