From 0614d7ddb38b70c88a62484d56ff5b3a90b121aa Mon Sep 17 00:00:00 2001 From: kazuhiko Date: Thu, 5 Oct 2000 04:57:05 +0000 Subject: [PATCH] Initial revision --- lisp/dialog-items.el | 115 +++++++++++++++++++++ lisp/update-elc-2.el | 148 ++++++++++++++++++++++++++ lisp/win32-native.el | 280 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 543 insertions(+) create mode 100644 lisp/dialog-items.el create mode 100644 lisp/update-elc-2.el create mode 100644 lisp/win32-native.el diff --git a/lisp/dialog-items.el b/lisp/dialog-items.el new file mode 100644 index 0000000..5d26ac1 --- /dev/null +++ b/lisp/dialog-items.el @@ -0,0 +1,115 @@ +;;; dialog-items.el --- Dialog-box content for XEmacs + +;; Copyright (C) 2000 Andy Piper. +;; Copyright (C) 2000 Ben Wing. + +;; Maintainer: XEmacs Development Team +;; Keywords: content, gui, internal, dumped + +;; This file is part of XEmacs. + +;; XEmacs 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. + +;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; +;; Simple search dialog +;; +(defvar search-dialog-direction t) +(defvar search-dialog-regexp nil) +(defvar search-dialog nil) + +(defun search-dialog-callback (parent image-instance event) + (save-selected-frame + (select-frame parent) + (let ((domain (frame-selected-window (event-channel event)))) + (funcall (if search-dialog-direction + (if search-dialog-regexp + 're-search-forward + 'search-forward) + (if search-dialog-regexp + 're-search-backward + 'search-backward)) + (glyph-image-property + (car (glyph-image-property + (nth 1 (glyph-image-property + search-dialog :items domain)) + :items domain)) :text domain)) + (isearch-highlight (match-beginning 0) (match-end 0))))) + +(defun make-search-dialog () + "Popup a search dialog box." + (interactive) + (let ((parent (selected-frame))) + (make-dialog-box + 'general + :parent parent + :title "Search" + :spec + (setq search-dialog + (make-glyph + `[layout + :orientation horizontal :justify left + ;; neither the following height/width nor the identical one + ;; below should be necessary! (see below) + :height 11 :width 40 + :border [string :data "Search"] + :items + ([layout :orientation vertical :justify left + :items + ([string :data "Search for:"] + [button :descriptor "Match Case" + :style toggle + :selected (not case-fold-search) + :callback (setq case-fold-search + (not case-fold-search))] + [button :descriptor "Regular Expression" + :style toggle + :selected search-dialog-regexp + :callback (setq search-dialog-regexp + (not search-dialog-regexp))] + [button :descriptor "Forwards" + :style radio + :selected search-dialog-direction + :callback (setq search-dialog-direction t)] + [button :descriptor "Backwards" + :style radio + :selected (not search-dialog-direction) + :callback (setq search-dialog-direction nil)] + )] + [layout :orientation vertical :justify left + :items + ([edit-field :width 15 :descriptor "" :active t + :face default :initial-focus t] + [button :width 10 :descriptor "Find Next" + :callback-ex + (lambda (image-instance event) + (search-dialog-callback ,parent + image-instance + event))] + [button :width 10 :descriptor "Cancel" + :callback-ex + (lambda (image-instance event) + (isearch-dehighlight) + (delete-frame + (event-channel event)))])])])) + ;; neither this height/width nor the identical one above should + ;; be necessary! (in fact, if you omit the one above, the layout + ;; sizes itself correctly; but the frame as a whole doesn't use + ;; the layout's size, as it should.) + :properties '(height 11 width 40)))) diff --git a/lisp/update-elc-2.el b/lisp/update-elc-2.el new file mode 100644 index 0000000..aa46fcf --- /dev/null +++ b/lisp/update-elc-2.el @@ -0,0 +1,148 @@ +;;; update-elc-2.el --- Recompile remaining .el files, post-dumping + +;; Copyright (C) 1997 by Free Software Foundation, Inc. +;; Copyright (C) 2000 Ben Wing. + +;; Author: Ben Wing , based on cleantree.el by +;; Steven L Baur +;; Maintainer: XEmacs Development Team +;; Keywords: internal + +;; This file is part of XEmacs. + +;; XEmacs 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. + +;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; This file should be used after XEmacs has been dumped, to recompile +;; all remaining out-of-date .els and clean up orphaned .elcs. It should +;; be called as +;; +;; xemacs -batch -vanilla -l update-elc-2.el -f batch-update-elc-2 ${dirname} +;; +;; where ${dirname} is the directory tree to recompile, usually `lisp'. +;; +;; Note that this is very different from update-elc.el, which is called +;; BEFORE dumping, handles only the files needed to dump, and is called +;; from temacs instead of xemacs. +;; +;; The original cleantree.el had the comment: This code is derived +;; from Gnus based on a suggestion by David Moore + +;;; Code: + +(defvar update-elc-ignored-dirs + `("." ".." "CVS" "SCCS" "RCS" ,@(unless (featurep 'mule) '("mule")))) + +(defvar update-elc-ignored-files + ;; note: entries here are regexps + '("^," ;; #### huh? + "^paths.el$" + "^loadup.el$" + "^loadup-el.el$" + "^update-elc.el$" + "^update-elc-2.el$" + "^dumped-lisp.el$" + "^make-docfile.el$" + "^site-start.el$" + "^site-load.el$" + "^site-init.el$" + "^version.el$" + "^very-early-lisp.el$")) + +;; SEEN accumulates the list of already-handled dirs. +(defun do-update-elc-2 (dir compile-stage-p seen) + (setq dir (file-name-as-directory dir)) + ;; Only scan this sub-tree if we haven't been here yet. + (unless (member (file-truename dir) seen) + (push (file-truename dir) seen) + + ;; Do this directory. + (if compile-stage-p + ;; Stage 2: Recompile necessary .els + (let ((files (directory-files dir t ".el$")) + file file-c) + (while (setq file (car files)) + (setq files (cdr files)) + (setq file-c (concat file "c")) + (when (and (file-exists-p file) + (or (not (file-exists-p file-c)) + (file-newer-than-file-p file file-c)) + (let (ignore) + (mapcar + #'(lambda (regexp) + (if (string-match regexp + (file-name-nondirectory file)) + (setq ignore t))) + update-elc-ignored-files) + (not ignore))) + (byte-compile-file file)))) + + ;; Stage 1. + ;; Remove out-of-date elcs + (let ((files (directory-files dir t ".el$")) + file file-c) + (while (setq file (car files)) + (setq files (cdr files)) + (setq file-c (concat file "c")) + (when (and (file-exists-p file-c) + (file-newer-than-file-p file file-c)) + (message "Removing out-of-date %s" file-c) + (delete-file file-c)))) + ;; Remove elcs without corresponding el + (let ((files (directory-files dir t ".elc$")) + file file-c) + (while (setq file-c (car files)) + (setq files (cdr files)) + (setq file (replace-in-string file-c "c$" "")) + (when (and (file-exists-p file-c) + (not (file-exists-p file))) + (message "Removing %s; no corresponding .el" file-c) + (delete-file file-c)))) + + ;; We descend recursively + (let ((dirs (directory-files dir t nil t)) + dir) + (while (setq dir (pop dirs)) + (when (and (not (member (file-name-nondirectory dir) + update-elc-ignored-dirs)) + (file-directory-p dir)) + (do-update-elc-2 dir compile-stage-p seen)))) + + ))) + + +(defun batch-update-elc-2 () + (defvar command-line-args-left) + (unless noninteractive + (error "`batch-update-elc-2' is to be used only with -batch")) + (let ((dir (car command-line-args-left))) + ;; We remove all the bad .elcs before any byte-compilation, because + ;; there may be dependencies between one .el and another (even across + ;; directories), and we don't want to load an out-of-date .elc while + ;; byte-compiling a file. + (message "Removing old or spurious .elcs in directory tree `%s'..." dir) + (do-update-elc-2 dir nil nil) + (message "Removing old or spurious .elcs in directory tree `%s'...done" + dir) + (message "Recompiling updated .els in directory tree `%s'..." dir) + (do-update-elc-2 dir t nil) + (message "Recompiling updated .els in directory tree `%s'...done" dir)) + (setq command-line-args-left nil)) + +;;; cleantree.el ends here diff --git a/lisp/win32-native.el b/lisp/win32-native.el new file mode 100644 index 0000000..8f9d8ac --- /dev/null +++ b/lisp/win32-native.el @@ -0,0 +1,280 @@ +;;; win32-native.el --- Lisp routines for MS Windows. + +;; Copyright (C) 1994 Free Software Foundation, Inc. +;; Copyright (C) 2000 Ben Wing. + +;; Maintainer: XEmacs Development Team +;; Keywords: mouse, dumped + +;; This file is part of XEmacs. + +;; XEmacs 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. + +;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Synched up with: Not synched with FSF. Almost completely divergent. +;;; (FSF has stuff in w32-fns.el and term/w32-win.el.) + +;;; Commentary: + +;; This file is dumped with XEmacs for MS Windows (without cygwin). + +;; Based on NT Emacs version by Geoff Voelker (voelker@cs.washington.edu) +;; Ported to XEmacs by Marc Paquette +;; Largely modified by Kirill M. Katsnelson + +;;; Code: + +;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch +;; for executing its command line argument (from simple.el). +;; #### Oh if we had an alist of shells and their command switches. +(setq shell-command-switch "/c") + +;; For appending suffixes to directories and files in shell +;; completions. This screws up cygwin users so we leave it out for +;; now. Uncomment this if you only ever want to use cmd. + +;(defun nt-shell-mode-hook () +; (setq comint-completion-addsuffix '("\\" . " ") +; comint-process-echoes t)) +;(add-hook 'shell-mode-hook 'nt-shell-mode-hook) + +;; Use ";" instead of ":" as a path separator (from files.el). +(setq path-separator ";") + +;; Set the null device (for compile.el). +;; #### There should be such a global thingy as null-device - kkm +(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))) + +;;---------------------------------------------------------------------- +;; Autosave hack +;;-------------------- + +;; Avoid creating auto-save file names containing invalid characters +;; (primarily "*", eg. for the *mail* buffer). +;; Avoid "doc lost for function" warning +(defun original-make-auto-save-file-name (&optional junk) + "You do not want to call this." + ) +(fset 'original-make-auto-save-file-name + (symbol-function 'make-auto-save-file-name)) + +(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. You can redefine this for customization. +See also `auto-save-file-name-p'." + (let ((name (original-make-auto-save-file-name)) + (start 0)) + ;; destructively replace occurrences of * or ? with $ + (while (string-match "[?*]" name start) + (aset name (match-beginning 0) ?$) + (setq start (1+ (match-end 0)))) + name)) + +;;---------------------------------------------------------------------- +;; Quoting process args +;;-------------------- + +(defvar debug-mswindows-process-command-lines nil + "If non-nil, output debug information about the command lines constructed. +This can be useful if you are getting process errors where the arguments +to the process appear to be getting passed incorrectly.") + +;; properly quotify one arg for the vc runtime argv constructor. +(defun mswindows-quote-one-vc-runtime-arg (arg &optional quote-shell) + ;; we mess with any arg with whitespace, quotes, or globbing chars in it. + ;; we also include shell metachars if asked. + ;; note that \ is NOT included! it's perfectly OK to include an + ;; arg like c:\ or c:\foo. + (if (string-match (if quote-shell "[ \t\n\r\f*?\"<>|&^%]" "[ \t\n\r\f*?\"]") + arg) + (progn + ;; handle nested quotes, possibly preceded by backslashes + (setq arg (replace-in-string arg "\\([\\]*\\)\"" "\\1\\1\\\\\"")) + ;; handle trailing backslashes + (setq arg (replace-in-string arg "\\([\\]+\\)$" "\\1\\1")) + (concat "\"" arg "\"")) + arg)) + +(defun mswindows-quote-one-simple-arg (arg &optional quote-shell) + ;; just put double quotes around args with spaces (and maybe shell + ;; metachars). + (if (string-match (if quote-shell "[ \t\n\r\f*?\"<>|&^%]" "[ \t\n\r\f*?]") + arg) + (concat "\"" arg "\"") + arg)) + +(defun mswindows-quote-one-command-arg (arg) + ;; quote an arg to get it past COMMAND.COM/CMD.EXE: need to quote shell + ;; metachars with ^. + (replace-in-string "[<>|&^%]" "^\\1" arg)) + +(defun mswindows-construct-verbatim-command-line (program args) + (mapconcat #'identity args " ")) + +;; for use with either standard VC++ compiled programs or Cygwin programs, +;; which emulate the same behavior. +(defun mswindows-construct-vc-runtime-command-line (program args) + (mapconcat #'mswindows-quote-one-vc-runtime-arg args " ")) + +;; note: for pulling apart an arg: +;; each arg consists of either + +;; something surrounded by single quotes + +;; or + +;; one or more of + +;; 1. a non-ws, non-" char +;; 2. a section of double-quoted text +;; 3. a section of double-quoted text with end-of-string instead of the final +;; quote. + +;; 2 and 3 get handled together. + +;; quoted text is one of +;; +;; 1. quote + even number of backslashes + quote, or +;; 2. quote + non-greedy anything + non-backslash + even number of +;; backslashes + quote. + +;; we need to separate the two because we unfortunately have no non-greedy +;; ? operator. (urk! we actually do, but it wasn't documented.) --ben + +;; if you want to mess around, keep this test case in mind: + +;; this string + +;; " as'f 'FOO BAR' '' \"\" \"asdf \\ \\\" \\\\\\\" asdfasdf\\\\\" foo\" " + +;; should tokenize into this: + +;; (" " "as'f" " " "'FOO BAR' " "'' " "\"\"" " " "\"asdf \\ \\\" \\\\\\\" asdfasdf\\\\\"" " " "foo" "\" ") + +;; this regexp actually separates the arg into individual args, like a +;; shell (such as sh) does, but using vc-runtime rules. it's easy to +;; derive the tokenizing regexp from it, and that's exactly what i did. +;; but oh was it hard to get this first regexp right. --ben +;(defvar mswindows-match-one-cmd-exe-arg-regexp +; (concat +; "^\\(" +; "'\\([\\]*\\)\\2'" "\\|" +; "'.*?[^\\]\\(\\([\\]*\\)\\4'\\)" "\\|" +; "\\(" +; "[^ \t\n\r\f\v\"]" "\\|" +; "\"\\([\\]*\\)\\6\"" "\\|" +; "\".*?[^\\]\\(\\([\\]*\\)\\8\"\\|$\\)" +; "\\)+" +; "\\)" +; "\\([ \t\n\r\f\v]+\\|$\\)")) + +(defvar mswindows-match-one-cmd-exe-token-regexp + (concat + "^\\(" + "[ \t\n\r\f\v]+" "\\|" + "'\\([\\]*\\)\\2'" "\\([ \t\n\r\f\v]+\\|$\\)" "\\|" + "'.*?[^\\]\\(\\([\\]*\\)\\5'\\)" "\\([ \t\n\r\f\v]+\\|$\\)" "\\|" + "[^ \t\n\r\f\v\"]+" "\\|" + "\"\\([\\]*\\)\\7\"" "\\|" + "\".*?[^\\]\\(\\([\\]*\\)\\9\"\\|$\\)" + "\\)")) + +(defun mswindows-construct-command-command-line (program args) + ;; for use with COMMAND.COM and CMD.EXE: + ;; for each arg, tokenize it into quoted and non-quoted sections; + ;; then quote all the shell meta-chars with ^; then put everything + ;; back together. the truly hard part is the tokenizing -- typically + ;; we get a single argument (the command to execute) and we have to + ;; worry about quotes that are backslash-quoted and such. + (mapconcat + #'(lambda (arg) + (mapconcat + #'(lambda (part) + (if (string-match "^'" part) + (replace-in-string part "\\([<>|^&%]\\)" "^\\1") + part)) + (let (parts) + (while (and (> (length arg) 0) + (string-match + mswindows-match-one-cmd-exe-token-regexp + arg)) + (push (match-string 0 arg) parts) + (setq arg (substring arg (match-end 0)))) + (if (> (length arg) 0) + (push arg parts)) + (nreverse parts)) + "")) + args " ")) + +(defvar mswindows-construct-process-command-line-alist + '(("[\\/].?.?sh\\." . mswindows-construct-verbatim-command-line) + ("[\\/]command\\.com$" . mswindows-construct-command-command-line) + ("[\\/]cmd\\.exe$" . mswindows-construct-command-command-line) + ("" . mswindows-construct-vc-runtime-command-line)) + "An alist for determining proper argument quoting given executable +file name. Car of each cons should be a string, a regexp against +which the file name is matched. Matching is case-insensitive but does +include the directory, so you should begin your regexp with [\\\\/] if +you don't want the directory to matter. Alternatively, the car can be +a function of one arg, which is called with the executable's name and +should return t if this entry should be processed. Cdr is a function +symbol, which is called with two args, the executable name and a list +of the args passed to it. It should return a string, which includes +the executable's args (but not the executable name itself) properly +quoted and pasted together. The list is matched in order, and the +first matching entry specifies how the processing will happen.") + +(defun mswindows-construct-process-command-line (args) + ;;Properly quote process ARGS for executing (car ARGS). + ;;Called from the C code. + (let ((fname (car args)) + (alist mswindows-construct-process-command-line-alist) + (case-fold-search t) + (return-me nil) + (assoc nil)) + (while (and alist + (null return-me)) + (setq assoc (pop alist)) + (if (if (stringp (car assoc)) + (string-match (car assoc) fname) + (funcall (car assoc) fname)) + (setq return-me (cdr assoc)))) + (let* ((called-fun (or return-me + #'mswindows-construct-vc-runtime-command-line)) + (retval + (let ((str (funcall called-fun fname (cdr args))) + (quoted-fname (mswindows-quote-one-simple-arg fname))) + (if (and str (> (length str) 0)) + (concat quoted-fname " " str) + quoted-fname)))) + (when debug-mswindows-process-command-lines + (debug-print "mswindows-construct-process-command-line called:\n") + (debug-print "received args: \n%s" + (let ((n -1)) + (mapconcat #'(lambda (arg) + (incf n) + (format " %d %s\n" n arg)) + args + ""))) + (debug-print "called fun %s\n" called-fun) + (debug-print "resulting command line: %s\n" retval)) + retval))) + +;;; win32-native.el ends here -- 1.7.10.4