Hold previous change until after the release.
This commit is contained in:
parent
4f0a10eb40
commit
b1d4be5f6e
5 changed files with 188 additions and 9 deletions
|
@ -164,8 +164,7 @@ lisp= \
|
|||
$(lispdir)\winnt.elc \
|
||||
$(lispdir)\float-sup.elc \
|
||||
$(lispdir)\vc-hooks.elc \
|
||||
$(lispdir)\version.el \
|
||||
$(lispdir)\dos-win32.elc
|
||||
$(lispdir)\version.el
|
||||
|
||||
DOC = DOC
|
||||
$(DOC): $(BLD)\make-docfile.exe
|
||||
|
|
|
@ -28,6 +28,21 @@
|
|||
|
||||
;;; 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 ";")
|
||||
|
||||
;; Set the null device (for compile.el).
|
||||
(setq grep-null-device "NUL")
|
||||
|
||||
;; Set the grep regexp to match entries with drive letters.
|
||||
(setq grep-regexp-alist
|
||||
'(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
|
||||
|
||||
;; This overrides a trivial definition in files.el.
|
||||
(defun convert-standard-filename (filename)
|
||||
"Convert a standard file's name to something suitable for the current OS.
|
||||
|
@ -78,6 +93,63 @@ with a definition that really does change some file names."
|
|||
(aset string (1- (length string)) lastchar))
|
||||
(concat dir string))))
|
||||
|
||||
(defvar file-name-buffer-file-type-alist
|
||||
'(
|
||||
("[:/].*config.sys$" . nil) ; config.sys text
|
||||
("\\.elc$" . t) ; emacs stuff
|
||||
("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
|
||||
; MS-Dos stuff
|
||||
("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
|
||||
; Packers
|
||||
("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
|
||||
; Unix stuff
|
||||
("\\.tp[ulpw]$" . t)
|
||||
; Borland Pascal stuff
|
||||
("[:/]tags$" . t)
|
||||
; 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.")
|
||||
|
||||
(defun find-buffer-file-type (filename)
|
||||
(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)))
|
||||
|
||||
(defun find-file-binary (filename)
|
||||
"Visit file FILENAME and treat it as binary."
|
||||
(interactive "FFind file binary: ")
|
||||
(let ((file-name-buffer-file-type-alist '(("" . t))))
|
||||
(find-file filename)))
|
||||
|
||||
(defun find-file-text (filename)
|
||||
"Visit file FILENAME and treat it as a text file."
|
||||
(interactive "FFind file text: ")
|
||||
(let ((file-name-buffer-file-type-alist '(("" . nil))))
|
||||
(find-file filename)))
|
||||
|
||||
(defun find-file-not-found-set-buffer-file-type ()
|
||||
(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)
|
||||
|
||||
(defvar msdos-shells '("command.com" "4dos.com" "ndos.com")
|
||||
"*List of shells that use `/c' instead of `-c' and a backslashed command.")
|
||||
|
||||
|
|
|
@ -114,16 +114,12 @@
|
|||
(garbage-collect)
|
||||
(load "disp-table") ; needed to setup ibm-pc char set, see internal.el
|
||||
(garbage-collect)
|
||||
(load "dos-win32")
|
||||
(garbage-collect)
|
||||
(load "winnt")
|
||||
(garbage-collect)))
|
||||
(if (eq system-type 'ms-dos)
|
||||
(progn
|
||||
(load "ls-lisp")
|
||||
(garbage-collect)
|
||||
(load "dos-win32")
|
||||
(garbage-collect)
|
||||
(load "dos-fns")
|
||||
(garbage-collect)
|
||||
(load "disp-table") ; needed to setup ibm-pc char set, see internal.el
|
||||
|
|
112
lisp/w32-fns.el
112
lisp/w32-fns.el
|
@ -39,6 +39,23 @@
|
|||
(define-key function-key-map [M-backspace] [?\M-\177])
|
||||
(define-key function-key-map [C-M-backspace] [\C-\M-delete])
|
||||
|
||||
;; Show file type (text or binary) on modeline
|
||||
(setq-default mode-line-format
|
||||
(list (purecopy "")
|
||||
'mode-line-modified
|
||||
'mode-line-buffer-identification
|
||||
(purecopy " ")
|
||||
'global-mode-string
|
||||
(purecopy " %[(")
|
||||
(purecopy "%t:")
|
||||
'mode-name 'mode-line-process 'minor-mode-alist
|
||||
(purecopy "%n")
|
||||
(purecopy ")%]--")
|
||||
(purecopy '(line-number-mode "L%l--"))
|
||||
(purecopy '(column-number-mode "C%c--"))
|
||||
(purecopy '(-3 . "%p"))
|
||||
(purecopy "-%-")))
|
||||
|
||||
;; Ignore case on file-name completion
|
||||
(setq completion-ignore-case t)
|
||||
|
||||
|
@ -46,6 +63,101 @@
|
|||
;; for executing its command line argument (from simple.el).
|
||||
(setq shell-command-switch "/c")
|
||||
|
||||
;; Use ";" instead of ":" as a path separator (from files.el).
|
||||
(setq path-separator ";")
|
||||
|
||||
;; Set the null device (for compile.el).
|
||||
(setq grep-null-device "NUL")
|
||||
|
||||
;; Set the grep regexp to match entries with drive letters.
|
||||
(setq grep-regexp-alist
|
||||
'(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
|
||||
|
||||
;; Taken from dos-fn.el ... don't want all that's in the file, maybe
|
||||
;; separate it out someday.
|
||||
|
||||
(defvar file-name-buffer-file-type-alist
|
||||
'(
|
||||
("[:/].*config.sys$" . nil) ; config.sys text
|
||||
("\\.elc$" . t) ; emacs stuff
|
||||
("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
|
||||
; MS-Dos stuff
|
||||
("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
|
||||
; Packers
|
||||
("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
|
||||
; Unix stuff
|
||||
("\\.tp[ulpw]$" . t)
|
||||
; Borland Pascal stuff
|
||||
("[:/]tags$" . t)
|
||||
; 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.")
|
||||
|
||||
(defun find-buffer-file-type (filename)
|
||||
(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)))
|
||||
|
||||
(defun find-file-binary (filename)
|
||||
"Visit file FILENAME and treat it as binary."
|
||||
(interactive "FFind file binary: ")
|
||||
(let ((file-name-buffer-file-type-alist '(("" . t))))
|
||||
(find-file filename)))
|
||||
|
||||
(defun find-file-text (filename)
|
||||
"Visit file FILENAME and treat it as a text file."
|
||||
(interactive "FFind file text: ")
|
||||
(let ((file-name-buffer-file-type-alist '(("" . nil))))
|
||||
(find-file filename)))
|
||||
|
||||
(defun find-file-not-found-set-buffer-file-type ()
|
||||
(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)
|
||||
|
||||
;;; For using attached Unix filesystems.
|
||||
(defun save-to-unix-hook ()
|
||||
(save-excursion
|
||||
(setq buffer-file-type t))
|
||||
nil)
|
||||
|
||||
(defun revert-from-unix-hook ()
|
||||
(save-excursion
|
||||
(setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
|
||||
nil)
|
||||
|
||||
;; Really should provide this capability at the drive letter granularity.
|
||||
(defun using-unix-filesystems (flag)
|
||||
"Read and write all files assuming that they are on a drive attached
|
||||
to a remote Unix file system. No CR/LF translation is done on any files
|
||||
in this case. This behavior is activated when FLAG is t and deactived
|
||||
when FLAG is any other value."
|
||||
(if flag
|
||||
(progn
|
||||
(add-hook 'write-file-hooks 'save-to-unix-hook)
|
||||
(add-hook 'after-save-hook 'revert-from-unix-hook))
|
||||
(progn
|
||||
(remove-hook 'write-file-hooks 'save-to-unix-hook)
|
||||
(remove-hook 'after-save-hook 'revert-from-unix-hook))))
|
||||
|
||||
;;; Avoid creating auto-save file names containing illegal characters
|
||||
;;; (primarily "*", eg. for the *mail* buffer).
|
||||
(fset 'original-make-auto-save-file-name
|
||||
|
|
|
@ -598,13 +598,13 @@ otherobj= $(termcapobj) lastfile.o $(mallocobj) $(allocaobj) $(widgetobj)
|
|||
#endif
|
||||
|
||||
#ifdef MSDOS
|
||||
#define MSDOS_SUPPORT ${lispsource}ls-lisp.elc ${lispsource}disp-table.elc ${lispsource}dos-fns.elc ${lispsource}dos-win32.elc
|
||||
#define MSDOS_SUPPORT ${lispsource}ls-lisp.elc ${lispsource}disp-table.elc ${lispsource}dos-fns.elc
|
||||
#else
|
||||
#define MSDOS_SUPPORT
|
||||
#endif
|
||||
|
||||
#ifdef WINDOWSNT
|
||||
#define WINNT_SUPPORT ${lispsource}ls-lisp.elc ${lispsource}winnt.elc ${lispsource}dos-win32.elc
|
||||
#define WINNT_SUPPORT ${lispsource}ls-lisp.elc ${lispsource}winnt.elc
|
||||
#else
|
||||
#define WINNT_SUPPORT
|
||||
#endif
|
||||
|
@ -700,7 +700,7 @@ SOME_MACHINE_LISP = ${dotdot}/lisp/faces.elc ${dotdot}/lisp/facemenu.elc \
|
|||
${dotdot}/lisp/select.elc ${dotdot}/lisp/scroll-bar.elc \
|
||||
${dotdot}/lisp/vmsproc.elc ${dotdot}/lisp/vms-patch.elc \
|
||||
${dotdot}/lisp/ls-lisp.elc ${dotdot}/lisp/dos-fns.elc \
|
||||
${dotdot}/lisp/winnt.elc ${dotdot}/lisp/dos-win32.elc
|
||||
${dotdot}/lisp/winnt.elc
|
||||
|
||||
/* Construct full set of libraries to be linked.
|
||||
Note that SunOS needs -lm to come before -lc; otherwise, you get
|
||||
|
|
Loading…
Add table
Reference in a new issue