Mercurial > hg > xemacs-beta
changeset 221:6c0ae1f9357f r20-4b9
Import from CVS: tag r20-4b9
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 10:10:02 +0200 |
| parents | 04f4bca7b601 |
| children | aae4c8b01452 |
| files | CHANGES-beta ChangeLog configure.usage lisp/ChangeLog lisp/dumped-lisp.el lisp/egg/egg-cwnn-leim.el lisp/egg/egg-jisx0201.el lisp/egg/egg-kwnn-leim.el lisp/font-lock.el lisp/msw-faces.el lisp/msw-init.el lisp/msw-select.el lisp/mule/canna-leim.el lisp/wid-edit.el lisp/x-toolbar.el nt/ChangeLog nt/Todo nt/config.h nt/xemacs.mak src/ChangeLog src/emacs.c src/event-stream.c src/frame-msw.c src/glyphs-x.c src/msw-proc.c src/select-msw.c src/symsinit.h version.sh |
| diffstat | 28 files changed, 1114 insertions(+), 559 deletions(-) [+] |
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 10:09:36 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 10:10:02 2007 +0200 @@ -1,4 +1,11 @@ -*- indented-text -*- +to 20.4 beta9 "Australian Goat" +-- MS Windows patches for clipboard courtesy of Jonathon Harris +-- ImageMagick support displays images now courtesy of Jareth Hein +-- Untested support for kWnn and cWnn (Korean and Chinese input with Egg and + Wnn added). +-- Miscellaneous bug fixes + to 20.4 beta8 "Arapawa Island" -- build-report 1.35 courtesy of Adrian Aichner -- MS Windows stuffs from David Hobley, Jonathon Harris, August Hill,
--- a/ChangeLog Mon Aug 13 10:09:36 2007 +0200 +++ b/ChangeLog Mon Aug 13 10:10:02 2007 +0200 @@ -1,3 +1,7 @@ +1997-12-09 SL Baur <steve@altair.xemacs.org> + + * XEmacs 20.4-beta9 is released. + 1997-12-06 SL Baur <steve@altair.xemacs.org> * XEmacs 20.4-beta8 is released.
--- a/configure.usage Mon Aug 13 10:09:36 2007 +0200 +++ b/configure.usage Mon Aug 13 10:10:02 2007 +0200 @@ -106,7 +106,7 @@ used on Linux and other systems. NOTE: We can't guarantee that our TERM support coexists well with standard Internet connections). ---with-database=type (*) Compile with database support. Valid types are +--with-database=TYPE (*) Compile with database support. Valid types are `no' or a comma-separated list of one or more of `dbm', `gnudbm', or `berkdb'. --with-sound=native (*) Compile with native sound support. @@ -124,7 +124,7 @@ are `lockf', `flock', and `file'. --package-path=PATH Directories to search for packages to dump with xemacs. Defaults to `/usr/local/lib/xemacs/packages:~/.xemacs'. ---infodir=dir Directory to install the XEmacs Info manuals and dir in. +--infodir=DIR Directory to install the XEmacs Info manuals and dir in. Defaults to: `'. --infopath=PATH Directories to search for Info documents, info dir and localdir files. This is used to initialize @@ -170,7 +170,7 @@ --debug Compile with support for debugging XEmacs. (Causes code-size increase and little loss of speed.) ---error-checking=TYPE[[,TYPE]]... +--error-checking=TYPE[,TYPE]... Compile with internal error-checking added. Causes noticeable loss of speed. Valid types are extents, bufpos, malloc, gc, typecheck. @@ -196,7 +196,7 @@ is system-dependent). --with-clash-detection Use lock files to detect multiple edits of the same file. The default is to not do clash detection. ---lockdir=dir The directory to put clash detection files in, such as +--lockdir=DIR The directory to put clash detection files in, such as `/var/lock/emacs'. Defaults to `${statedir}/xemacs/lock'. --with-system-malloc Force use of the system malloc, rather than GNU malloc.
--- a/lisp/ChangeLog Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 10:10:02 2007 +0200 @@ -1,3 +1,44 @@ +1997-12-06 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * dumped-lisp.el, emacs.c, symsinit.h, msw-init.el, nt/xemacs.mak + Created files: msw-select.el, select-msw.c + Copy and paste 8-bit text to/from mswindows clipboard. + + * msw-faces.el: mswindows-make-font-bold[-italic] + Try to make the bold font the same width as the non-bold font. + +1997-12-07 Hrvoje Niksic <hniksic@srce.hr> + + * wid-edit.el (widget-prettyprint-to-string): Nix cl-prettyprint's + newlines. + +1997-12-06 Hrvoje Niksic <hniksic@srce.hr> + + * x-toolbar.el (toolbar-not-configured): Use `error'. + (toolbar-compile): Restore `toolbar-already-run' feature from + 19.15. + (toolbar-news): Use `eval' on non-symbols. + (toolbar-info-frame-plist): Use the new `plist' widget. + (toolbar-news-frame-plist): Ditto. + + * font-lock.el (font-lock-fontify-buffer-function): New variable, + synched with FSF Emacs 20. + (font-lock-unfontify-buffer-function): Ditto. + (font-lock-fontify-region-function): Ditto. + (font-lock-unfontify-region-function): Ditto. + (font-lock-inhibit-thing-lock): Ditto. + +1997-12-07 SL Baur <steve@altair.xemacs.org> + + * egg/egg-cwnn-leim.el (egg-pinyin-activate): New file. Interface + to Chinese Wnn server. + + * egg/egg-kwnn-leim.el: New file. Interface to Korean Wnn + server. + + * dumped-lisp.el (preloaded-file-list): Dump LEIM integration + files for kWnn and cWnn. + 1997-11-30 Adrian Aichner <aichner@ecf.teradyne.com> * build-report.el:
--- a/lisp/dumped-lisp.el Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/dumped-lisp.el Mon Aug 13 10:10:02 2007 +0200 @@ -132,6 +132,8 @@ ;; Specialized language support #+(and mule CANNA) "canna-leim" #+(and mule wnn) "egg-leim" + #+(and mule wnn) "egg-kwnn-leim" + #+(and mule wnn) "egg-cwnn-leim" #+mule "egg-sj3-leim" #+mule "skk-leim" @@ -159,6 +161,7 @@ ;; preload the mswindows code. #+mswindows "msw-faces" #+mswindows "msw-init" + #+mswindows "msw-select" ;; preload the TTY init code. #+tty "tty-init" ;;; Formerly in tooltalk/tooltalk-load.el
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/egg/egg-cwnn-leim.el Mon Aug 13 10:10:02 2007 +0200 @@ -0,0 +1,108 @@ +;;; egg-cwnn-leim.el --- Egg/CWnn-related code for LEIM + +;; Copyright (C) 1997 Stephen Turnbull <turnbull@sk.tsukuba.ac.jp> +;; Copyright (C) 1997 Free Software Foundation, Inc. +;; +;; Shamelessly ripped off from +;; +;; skk-leim.el --- SKK related code for LEIM +;; Copyright (C) 1997 +;; Murata Shuuichirou <mrt@mickey.ai.kyutech.ac.jp> +;; +;; Author: Stephen Turnbull <turnbull@sk.tsukuba.ac.jp> +;; Version: egg-leim.el,v 1.1 1997/10/27 09:59:23 steve Exp steve +;; Keywords: japanese, input method, LEIM +;; Last Modified: 1997/10/27 09:59:23 + +;; This program 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 versions 2, or (at your option) +;; any later version. + +;; This program 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. + +;;; TODO +;; +;; Add pointers to Egg documentation in LEIM format + +;; EGG specific setup +(define-egg-environment 'chinese-pinyin + "Chinese pinyin settings for egg." + (lambda () + (when (not (featurep 'egg-cnpinyin)) + (load "its/its-pinyin") + (setq its:*standard-modes* + (append + (list (its:get-mode-map "PinYin")) + its:*standard-modes*)) + (provide 'egg-cnpinyin)) + (setq wnn-server-type 'cserver) + (setq-default its:*current-map* (its:get-mode-map "PinYin")))) + +(define-egg-environment 'chinese-zhuyin + "Chinese zhuyin settings for egg." + (lambda () + (when (not (featurep 'egg-cnzhuyin)) + (load "its/its-zhuyin") + (setq its:*standard-modes* + (append + (list (its:get-mode-map "zhuyin")) + its:*standard-modes*)) + (provide 'egg-cnzhuyin)) + (setq wnn-server-type 'cserver) + (setq-default its:*current-map* (its:get-mode-map "zhuyin")))) + + +(defun egg-pinyin-activate (&optional name) + (if (featurep 'wnn) + (require 'egg) + (error "Wnn is not built into this XEmacs")) + (setq inactivate-current-input-method-function 'egg-pinyin-inactivate) + (setq egg-default-startup-file "eggrc-wnn") + (require 'egg-wnn) + (let ((func (get 'chinese-pinyin 'set-egg-environ))) + (when func + (funcall func))) + (egg-mode) + (toggle-egg-mode)) + +(defun egg-pinyin-inactivate () + (cond (egg:*mode-on* (toggle-egg-mode)))) + +(defun egg-zhuyin-activate (&optional name) + (if (featurep 'wnn) + (require 'egg) + (error "Wnn is not built into this XEmacs")) + (setq inactivate-current-input-method-function 'egg-zhuyin-inactivate) + (setq egg-default-startup-file "eggrc-wnn") + (require 'egg-wnn) + (let ((func (get 'chinese-zhuyin 'set-egg-environ))) + (when func + (funcall func))) + (egg-mode) + (toggle-egg-mode)) + +(defun egg-zhuyin-inactivate () + (cond (egg:*mode-on* (toggle-egg-mode)))) + +(register-input-method + 'chinese-egg-pinyin "Chinese" + 'egg-zhuyin-activate nil + "EGG - an interface to the CWnn Chinese conversion program" ) + +(register-input-method + 'chinese-egg-zhuyin "Chinese" + 'egg-zhuyin-activate nil + "EGG - an interface to the CWnn Chinese conversion program" ) + +(provide 'egg-cwnn-leim) + +;;; egg-cwnn-leim.el ends here
--- a/lisp/egg/egg-jisx0201.el Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/egg/egg-jisx0201.el Mon Aug 13 10:10:02 2007 +0200 @@ -142,15 +142,15 @@ (goto-char (point-min)) (let ((regexp (if arg "\\cS\\|\\cK\\|\\cH" "\\cS\\|\\cK"))) (while (re-search-forward regexp (point-max) (point-max)) - (let* ((ch (preceding-char)) - (ch1 (char-octet ch 0)) - (ch2 (char-octet ch 1))) - (cond ((= ?\241 ch1) + (let* ((ch (char-to-int (char-before))) + (ch1 (/ ch 256)) + (ch2 (mod ch 256))) + (cond ((= 208 ch1) (let ((val (cdr (assq ch2 *katakana-kigou-alist*)))) (if val (progn (delete-char -1) (insert val))))) - ((or (= ?\242 ch1) (= ?\250 ch1)) + ((or (= 209 ch1) (= 215 ch1)) nil) (t (let ((val (cdr (assq ch2 *katakana-alist*)))) @@ -233,12 +233,12 @@ (char-to-string ch) *katakana-alist*)) (progn (delete-char -1) - (insert (make-char 'japanese-jisx0208 ?\045 wk)))) + (insert (make-char 'japanese-jisx0208 37 (- wk 128))))) ((setq wk (search-henkan-alist (char-to-string ch) *katakana-kigou-alist*)) (progn (delete-char -1) - (insert (make-char 'japanese-jisx0208 ?\041 wk))))))))) + (insert (make-char 'japanese-jisx0208 33 (- wk 128)))))))))) (defun zenkaku-katakana-paragraph () "zenkaku-katakana paragraph at or after point."
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/egg/egg-kwnn-leim.el Mon Aug 13 10:10:02 2007 +0200 @@ -0,0 +1,59 @@ +;;; egg-kwnn-leim.el --- Egg/CWnn-related code for LEIM + +;; Copyright (C) 1997 Stephen Turnbull <turnbull@sk.tsukuba.ac.jp> +;; Copyright (C) 1997 Free Software Foundation, Inc. +;; +;; Shamelessly ripped off from +;; +;; skk-leim.el --- SKK related code for LEIM +;; Copyright (C) 1997 +;; Murata Shuuichirou <mrt@mickey.ai.kyutech.ac.jp> +;; +;; Author: Stephen Turnbull <turnbull@sk.tsukuba.ac.jp> +;; Version: egg-leim.el,v 1.1 1997/10/27 09:59:23 steve Exp steve +;; Keywords: japanese, input method, LEIM +;; Last Modified: 1997/10/27 09:59:23 + +;; This program 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 versions 2, or (at your option) +;; any later version. + +;; This program 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. + +;;; TODO +;; +;; Add pointers to Egg documentation in LEIM format + +(defun egg-kwnn-activate (&optional name) + (if (featurep 'wnn) + (require 'egg) + (error "Wnn is not built into this XEmacs")) + (setq inactivate-current-input-method-function 'egg-kwnn-inactivate) + (setq egg-default-startup-file "eggrc-wnn") + (require 'egg-wnn) + (let ((func (get 'korean 'set-egg-environ))) + (when func + (funcall func))) + (egg-mode) + (toggle-egg-mode)) + +(defun egg-kwnn-inactivate () + (cond (egg:*mode-on* (toggle-egg-mode)))) + +(register-input-method + 'korean-egg "Korean" + 'egg-kwnn-activate nil + "EGG - an interface to the kWnn Korean conversion program" ) + +(provide 'egg-kwnn-leim) + +;;; egg-kwnn-leim.el ends here
--- a/lisp/font-lock.el Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/font-lock.el Mon Aug 13 10:10:02 2007 +0200 @@ -153,9 +153,10 @@ Comments will be displayed in `font-lock-comment-face'. Strings will be displayed in `font-lock-string-face'. Doc strings will be displayed in `font-lock-doc-string-face'. -Function and variable names (in their defining forms) will be - displayed in `font-lock-function-name-face'. -Reserved words will be displayed in `font-lock-keyword-face'." +Function and variable names (in their defining forms) will be displayed + in `font-lock-function-name-face'. +Reserved words will be displayed in `font-lock-keyword-face'. +Preprocessor conditionals will be displayed in `font-lock-preprocessor-face'." :group 'languages) (defgroup font-lock-faces nil @@ -500,6 +501,31 @@ This is normally set via `font-lock-defaults'.") (make-variable-buffer-local 'font-lock-beginning-of-syntax-function) +(defvar font-lock-fontify-buffer-function 'font-lock-default-fontify-buffer + "Function to use for fontifying the buffer. +This is normally set via `font-lock-defaults'.") + +(defvar font-lock-unfontify-buffer-function 'font-lock-default-unfontify-buffer + "Function to use for unfontifying the buffer. +This is used when turning off Font Lock mode. +This is normally set via `font-lock-defaults'.") + +(defvar font-lock-fontify-region-function 'font-lock-default-fontify-region + "Function to use for fontifying a region. +It should take two args, the beginning and end of the region, and an optional +third arg VERBOSE. If non-nil, the function should print status messages. +This is normally set via `font-lock-defaults'.") + +(defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region + "Function to use for unfontifying a region. +It should take two args, the beginning and end of the region. +This is normally set via `font-lock-defaults'.") + +(defvar font-lock-inhibit-thing-lock nil + "List of Font Lock mode related modes that should not be turned on. +Currently, valid mode names as `fast-lock-mode' and `lazy-lock-mode'. +This is normally set via `font-lock-defaults'.") + ;;;###autoload (defvar font-lock-mode nil) ; for modeline (defvar font-lock-fontified nil) ; whether we have hacked this buffer @@ -630,7 +656,7 @@ (defface font-lock-preprocessor-face '((((class color) (background dark)) (:foreground "steelblue1")) - (((class color) (background black)) (:foreground "blue3")) + (((class color) (background light)) (:foreground "blue3")) (t (:underline t))) "Font Lock Mode face used to highlight preprocessor conditionals." :group 'font-lock-faces) @@ -821,46 +847,11 @@ "Unconditionally turn off Font Lock mode." (font-lock-mode 0)) -;;;###autoload -(defun font-lock-fontify-buffer () - "Fontify the current buffer the way `font-lock-mode' would. -See `font-lock-mode' for details. +;;; FSF has here: -This can take a while for large buffers." - (interactive) - (let ((was-on font-lock-mode) - (font-lock-verbose (or font-lock-verbose (interactive-p))) - (font-lock-message-threshold 0) - (aborted nil)) - ;; Turn it on to run hooks and get the right font-lock-keywords. - (or was-on (font-lock-mode 1)) - (font-lock-unfontify-region (point-min) (point-max) t) -;; (buffer-syntactic-context-flush-cache) - - ;; If a ^G is typed during fontification, abort the fontification, but - ;; return normally (do not signal.) This is to make it easy to abort - ;; fontification if it's taking a long time, without also causing the - ;; buffer not to pop up. If a real abort is desired, the user can ^G - ;; again. - ;; - ;; Possibly this should happen down in font-lock-fontify-region instead - ;; of here, but since that happens from the after-change-hook (meaning - ;; much more frequently) I'm afraid of the bad consequences of stealing - ;; the interrupt character at inopportune times. - ;; - (condition-case nil - (save-excursion - (font-lock-fontify-region (point-min) (point-max))) - (quit - (setq aborted t))) +;; support for add-keywords, global-font-lock-mode and +;; font-lock-support-mode (unified support for various *-lock modes). - (or was-on ; turn it off if it was off. - (let ((font-lock-fontified nil)) ; kludge to prevent defontification - (font-lock-mode 0))) - (set (make-local-variable 'font-lock-fontified) t) - (when (and aborted font-lock-verbose) - (lmessage 'command "Fontifying %s... aborted." (buffer-name)))) - (run-hooks 'font-lock-after-fontify-buffer-hook)) ;; Fontification functions. @@ -906,10 +897,112 @@ ;; Fontification functions. -;; We use this wrapper. However, `font-lock-fontify-region' used to be the -;; name used for `font-lock-fontify-syntactically-region', so a change isn't -;; back-compatible. But you shouldn't be calling these directly, should you? +;; Rather than the function, e.g., `font-lock-fontify-region' containing the +;; code to fontify a region, the function runs the function whose name is the +;; value of the variable, e.g., `font-lock-fontify-region-function'. Normally, +;; the value of this variable is, e.g., `font-lock-default-fontify-region' +;; which does contain the code to fontify a region. However, the value of the +;; variable could be anything and thus, e.g., `font-lock-fontify-region' could +;; do anything. The indirection of the fontification functions gives major +;; modes the capability of modifying the way font-lock.el fontifies. Major +;; modes can modify the values of, e.g., `font-lock-fontify-region-function', +;; via the variable `font-lock-defaults'. +;; +;; For example, Rmail mode sets the variable `font-lock-defaults' so that +;; font-lock.el uses its own function for buffer fontification. This function +;; makes fontification be on a message-by-message basis and so visiting an +;; RMAIL file is much faster. A clever implementation of the function might +;; fontify the headers differently than the message body. (It should, and +;; correspondingly for Mail mode, but I can't be bothered to do the work. Can +;; you?) This hints at a more interesting use... +;; +;; Languages that contain text normally contained in different major modes +;; could define their own fontification functions that treat text differently +;; depending on its context. For example, Perl mode could arrange that here +;; docs are fontified differently than Perl code. Or Yacc mode could fontify +;; rules one way and C code another. Neat! +;; +;; A further reason to use the fontification indirection feature is when the +;; default syntactual fontification, or the default fontification in general, +;; is not flexible enough for a particular major mode. For example, perhaps +;; comments are just too hairy for `font-lock-fontify-syntactically-region' to +;; cope with. You need to write your own version of that function, e.g., +;; `hairy-fontify-syntactically-region', and make your own version of +;; `hairy-fontify-region' call that function before calling +;; `font-lock-fontify-keywords-region' for the normal regexp fontification +;; pass. And Hairy mode would set `font-lock-defaults' so that font-lock.el +;; would call your region fontification function instead of its own. For +;; example, TeX modes could fontify {\foo ...} and \bar{...} etc. multi-line +;; directives correctly and cleanly. (It is the same problem as fontifying +;; multi-line strings and comments; regexps are not appropriate for the job.) + +;;;###autoload +(defun font-lock-fontify-buffer () + "Fontify the current buffer the way `font-lock-mode' would. +See `font-lock-mode' for details. + +This can take a while for large buffers." + (interactive) + (let ((font-lock-verbose (or font-lock-verbose (interactive-p)))) + (funcall font-lock-fontify-buffer-function))) + +(defun font-lock-unfontify-buffer () + (funcall font-lock-unfontify-buffer-function)) + (defun font-lock-fontify-region (beg end &optional loudly) + (funcall font-lock-fontify-region-function beg end loudly)) + +(defun font-lock-unfontify-region (beg end &optional loudly) + (funcall font-lock-unfontify-region-function beg end loudly)) + +;; #### In these functions, the FSF is careful to do +;; (save-restriction +;; (widen) +;; before anything else. Should we copy? +(defun font-lock-default-fontify-buffer () + (interactive) + (let ((was-on font-lock-mode) + (font-lock-verbose (or font-lock-verbose (interactive-p))) + (font-lock-message-threshold 0) + (aborted nil)) + ;; Turn it on to run hooks and get the right font-lock-keywords. + (or was-on (font-lock-mode 1)) + (font-lock-unfontify-region (point-min) (point-max) t) +;; (buffer-syntactic-context-flush-cache) + + ;; If a ^G is typed during fontification, abort the fontification, but + ;; return normally (do not signal.) This is to make it easy to abort + ;; fontification if it's taking a long time, without also causing the + ;; buffer not to pop up. If a real abort is desired, the user can ^G + ;; again. + ;; + ;; Possibly this should happen down in font-lock-fontify-region instead + ;; of here, but since that happens from the after-change-hook (meaning + ;; much more frequently) I'm afraid of the bad consequences of stealing + ;; the interrupt character at inopportune times. + ;; + (condition-case nil + (save-excursion + (font-lock-fontify-region (point-min) (point-max))) + (quit + (setq aborted t))) + + (or was-on ; turn it off if it was off. + (let ((font-lock-fontified nil)) ; kludge to prevent defontification + (font-lock-mode 0))) + (set (make-local-variable 'font-lock-fontified) t) + (when (and aborted font-lock-verbose) + (lmessage 'command "Fontifying %s... aborted." (buffer-name)))) + (run-hooks 'font-lock-after-fontify-buffer-hook)) + +(defun font-lock-default-unfontify-buffer () + (font-lock-unfontify-region (point-min) (point-max)) + (set (make-local-variable 'font-lock-fontified) nil)) + +;; This used to be `font-lock-fontify-region', and before that, +;; `font-lock-fontify-region' used to be the name used for what is now +;; `font-lock-fontify-syntactically-region'. +(defun font-lock-default-fontify-region (beg end &optional loudly) (let ((modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) (old-syntax-table (syntax-table)) @@ -935,7 +1028,7 @@ ; (or (nth 4 state) (nth 7 state)))) ; (font-lock-fontify-keywords-region beg end)) -(defun font-lock-unfontify-region (beg end &optional maybe-loudly) +(defun font-lock-default-unfontify-region (beg end &optional maybe-loudly) (when (and maybe-loudly font-lock-verbose (>= (- end beg) font-lock-message-threshold)) (lmessage 'progress "Fontifying %s..." (buffer-name))) @@ -1437,6 +1530,8 @@ (defalias 'font-lock-revert-cleanup 'turn-on-font-lock) +;; Various functions. + (defun font-lock-compile-keywords (&optional keywords) ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string. @@ -1739,6 +1834,10 @@ "file\\)\\)\\)" "\\)\\>") 1) ;; + ;; Feature symbols as references. + '("(\\(featurep\\|provide\\|require\\)\\>[ \t']*\\(\\sw+\\)?" + (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) + ;; ;; Words inside \\[] tend to be for `substitute-command-keys'. '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-reference-face prepend) ;; @@ -2139,182 +2238,13 @@ (defvar c++-font-lock-keywords c++-font-lock-keywords-1 "Default expressions to highlight in C++ mode.") + +;;; Java. -;; The previous version, before replacing it with the FSF version. -;(defconst c-font-lock-keywords-1 nil -; "For consideration as a value of `c-font-lock-keywords'. -;This does fairly subdued highlighting.") -; -;(defconst c-font-lock-keywords-2 nil -; "For consideration as a value of `c-font-lock-keywords'. -;This does a lot more highlighting.") -; -;(let ((storage "auto\\|extern\\|register\\|static\\|volatile") -; (prefixes "unsigned\\|short\\|long\\|const") -; (types (concat "int\\|long\\|char\\|float\\|double\\|void\\|struct\\|" -; "union\\|enum\\|typedef")) -; (ctoken "\\(\\sw\\|\\s_\\|[:~*&]\\)+") -; ) -; (setq c-font-lock-keywords-1 (purecopy -; (list -; ;; fontify preprocessor directives. -; '("^#[ \t]*[a-z]+" . font-lock-preprocessor-face) -; ;; -; ;; fontify names being defined. -; '("^#[ \t]*\\(define\\|undef\\)[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 2 -; font-lock-function-name-face) -; ;; -; ;; fontify other preprocessor lines. -; '("^#[ \t]*\\(if\\|ifn?def\\|elif\\)[ \t]+\\([^\n]+\\)" -; 2 font-lock-function-name-face t) -; ;; -; ;; fontify the filename in #include <...> -; ;; don't need to do this for #include "..." because those were -; ;; already fontified as strings by the syntactic pass. -; ;; (Changed to not include the <> in the face, since "" aren't.) -; '("^#[ \t]*include[ \t]+<\\([^>\"\n]+\\)>" 1 font-lock-string-face) -; ;; -; ;; fontify the names of functions being defined. -; ;; I think this should be fast because it's anchored at bol, but it's not. -; (list (concat -; "^\\(" ctoken "[ \t]+\\)?" ; type specs; there can be no -; "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? -; "\\(" ctoken "[ \t]+\\)?" -; "\\([*&]+[ \t]*\\)?" ; pointer -; "\\(" ctoken "\\)[ \t]*(") ; name -; 8 'font-lock-function-name-face) -; ;; -; ;; This is faster but not by much. I don't see why not. -;; (list (concat "^\\(" ctoken "\\)[ \t]*(") 1 'font-lock-function-name-face) -; ;; -; ;; Fontify structure names (in structure definition form). -; (list (concat "^\\(typedef[ \t]+struct\\|struct\\|static[ \t]+struct\\)" -; "[ \t]+\\(" ctoken "\\)[ \t]*\\(\{\\|$\\)") -; 2 'font-lock-function-name-face) -; ;; -; ;; Fontify case clauses. This is fast because its anchored on the left. -; '("case[ \t]+\\(\\(\\sw\\|\\s_\\)+\\):". 1) -; '("\\<\\(default\\):". 1) -; ))) -; -; (setq c-font-lock-keywords-2 (purecopy -; (append c-font-lock-keywords-1 -; (list -; ;; -; ;; fontify all storage classes and type specifiers -; ;; types should be surrounded by non alphanumerics (Raymond Toy) -; (cons (concat "\\<\\(" storage "\\)\\>") 'font-lock-type-face) -; (list (concat "\\([^a-zA-Z0-9_]\\|^\\)\\(" -; types -; "\\)\\([^a-zA-Z0-9_]\\|$\\)") -; 2 'font-lock-type-face) -; ;; fontify the prefixes now. The types should have been fontified -; ;; previously. -; (list (concat "\\<\\(" prefixes "\\)[ \t]+\\(" types "\\)\\>") -; 1 'font-lock-type-face) -; ;; -; ;; fontify all builtin tokens -; (cons (concat -; "[ \t]\\(" -; (mapconcat 'identity -; '("for" "while" "do" "return" "goto" "case" "break" "switch" -; "if" "then" "else if" "else" "return" "continue" "default" -; ) -; "\\|") -; "\\)[ \t\n(){};,]") -; 1) -; ;; -; ;; fontify case targets and goto-tags. This is slow because the -; ;; expression is anchored on the right. -; "\\(\\(\\sw\\|\\s_\\)+\\):" -; ;; -; ;; Fontify variables declared with structures, or typedef names. -; '("}[ \t*]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t]*[,;]" -; 1 font-lock-function-name-face) -; ;; -; ;; Fontify global variables without a type. -;; '("^\\([_a-zA-Z0-9:~*]+\\)[ \t]*[[;={]" 1 font-lock-function-name-face) -; -; )))) -; ) -; -; -;;; default to the gaudier variety? -;;(defconst c-font-lock-keywords c-font-lock-keywords-2 -;; "Additional expressions to highlight in C mode.") -;(defconst c-font-lock-keywords c-font-lock-keywords-1 -; "Additional expressions to highlight in C mode.") -; -;(defconst c++-font-lock-keywords-1 nil -; "For consideration as a value of `c++-font-lock-keywords'. -;This does fairly subdued highlighting.") -; -;(defconst c++-font-lock-keywords-2 nil -; "For consideration as a value of `c++-font-lock-keywords'. -;This does a lot more highlighting.") -; -;(let ((ctoken "\\(\\sw\\|\\s_\\|[:~*&]\\)+") -; (c++-types (concat "complex\\|public\\|private\\|protected\\|virtual\\|" -; "friend\\|inline")) -; c++-font-lock-keywords-internal-1 -; c++-font-lock-keywords-internal-2 -; ) -; (setq c++-font-lock-keywords-internal-1 (purecopy -; (list -; ;; -; ;; fontify friend operator functions -; '("^\\(operator[^(]*\\)(" 1 font-lock-function-name-face) -; '("^\\(operator[ \\t]*([ \\t]*)[^(]*\\)(" 1 font-lock-function-name-face) -; -; ;; fontify the class names only in the definition -; (list (concat "^class[ \t]+" ctoken "[ \t\n{: ;]") 1 -; 'font-lock-function-name-face) -; -; (list (concat -; "^\\(" ctoken "[ \t]+\\)?" ; type specs; there can be no -; "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? -; "\\(" ctoken "[ \t]+\\)?" -; "\\(\\*+[ \t]*\\)?" ; pointer -; "\\(" ctoken "\\(::\\)?~?\\(\\(operator[ \t]*[^ \ta-zA-Z]+\\)\\|" -; ctoken "\\)\\)[ \t]*(") ; name -; 8 'font-lock-function-name-face t) -; ))) -; -; (setq c++-font-lock-keywords-internal-2 (purecopy -; (list -; ;; fontify extra c++ storage classes and type specifiers -; (cons (concat "\\<\\(" c++-types "\\)\\>") 'font-lock-type-face) -; -; ;;special check for class -; '("^\\(\\<\\|template[ \t]+<[ \t]*\\)\\(class\\)[ \t\n]+" 2 -; font-lock-type-face) -; -; ;; special handling of template -; "^\\(template\\)\\>" -; ;; fontify extra c++ builtin tokens -; (cons (concat -; "[ \t]\\(" -; (mapconcat 'identity -; '("asm" "catch" "throw" "try" "delete" "new" "operator" -; "sizeof" "this" -; ) -; "\\|") -; "\\)[ \t\n(){};,]") -; 1) -; ))) -; -; (setq c++-font-lock-keywords-1 (purecopy -; (append c-font-lock-keywords-1 c++-font-lock-keywords-internal-1))) -; -; (setq c++-font-lock-keywords-2 (purecopy -; (append c-font-lock-keywords-2 c++-font-lock-keywords-internal-1 -; c++-font-lock-keywords-internal-2))) -; ) -; -;(defconst c++-font-lock-keywords c++-font-lock-keywords-1 -; "Additional expressions to highlight in C++ mode.") - -;; Java support from Anders Lindgren and Bob Weiner +;; Java support has been written by XEmacs people, and it's apparently +;; totally divergent from the FSF. I don't know if it's better or +;; worse, so I'm leaving it in until someone convinces me the FSF +;; version is better. --hniksic (defconst java-font-lock-keywords-1 nil "For consideration as a value of `java-font-lock-keywords'. @@ -2613,33 +2543,6 @@ 3 (if (match-beginning 2) 'bold 'italic) keep)) "Default expressions to highlight in TeX modes.") -;; The previous version, before replacing it with the FSF version. -;(defconst tex-font-lock-keywords (purecopy -; (list -; ;; Lionel Mallet: Thu Oct 14 09:41:38 1993 -; ;; I've added an exit condition to the regexp below, and the other -; ;; regexps for the second part. -; ;; What would be useful here is something like: -; ;; ("\\(\\\\\\w+\\)\\({\\(\\w+\\)}\\)+" 1 font-lock-keyword-face t 3 -; ;; font-lock-function-name-face t) -; '("\\(\\\\\\w+\\)\\W" 1 font-lock-keyword-face t) -; '("\\(\\\\\\w+\\){\\([^}\n]+\\)}" 2 font-lock-function-name-face t) -; '("\\(\\\\\\w+\\){\\(\\w+\\)}{\\(\\w+\\)}" 3 -; font-lock-function-name-face t) -; '("\\(\\\\\\w+\\){\\(\\w+\\)}{\\(\\w+\\)}{\\(\\w+\\)}" 4 -; font-lock-function-name-face t) -; '("{\\\\\\(em\\|tt\\)\\([^}]+\\)}" 2 font-lock-comment-face t) -; '("{\\\\bf\\([^}]+\\)}" 1 font-lock-keyword-face t) -; '("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)\\W" 1 font-lock-function-name-face t) -; ;; Lionel Mallet: Thu Oct 14 09:40:10 1993 -; ;; the regexp below is useless as it is now covered by the first 2 regexps -; ;; '("\\\\\\(begin\\|end\\){\\([a-zA-Z0-9\\*]+\\)}" -; ;; 2 font-lock-function-name-face t) -; '("[^\\\\]\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) -;; '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) -; )) -; "Additional expressions to highlight in TeX mode.") - (defconst ksh-font-lock-keywords (purecopy (list '("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face)
--- a/lisp/msw-faces.el Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/msw-faces.el Mon Aug 13 10:10:02 2007 +0200 @@ -64,8 +64,8 @@ (defun mswindows-font-canicolize-name (font) "Given a mswindows font specification, this returns its name in canonical form." - (cond ((font-instance-p font) - (let ((name (font-instance-name font))) + (if (font-instance-p font) + (let ((name (font-instance-name font))) (cond ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$" name) name) @@ -74,22 +74,29 @@ ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name) (concat name "::ansi")) ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name) - (concat name "10::ansi")) + (concat name ":10::ansi")) ((string-match "^[a-zA-Z ]+$" name) (concat name ":Normal:10::ansi")) - (t "Courier New:Normal:10::ansi")))) - (t "Courier New:Normal:10::ansi"))) + (t "Courier New:Normal:10::ansi"))))) (defun mswindows-make-font-bold (font &optional device) "Given a mswindows font specification, this attempts to make a bold font. If it fails, it returns nil." (if (font-instance-p font) - (let ((name (mswindows-font-canicolize-name font))) + (let ((name (mswindows-font-canicolize-name font)) + (oldwidth (font-instance-width font))) (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) - (make-font-instance (concat - (substring name 0 (match-beginning 1)) - "Bold" (substring name (match-end 1))) - device t)))) + (let ((newfont (make-font-instance + (concat (substring name 0 (match-beginning 1)) + "Bold" (substring name (match-end 1))) + device t))) +; Hack! on mswindows, bold fonts (even monospaced) are often wider than the +; equivalent non-bold font. Making the bold font one point smaller usually +; makes it the same width (maybe at the expense of making it one pixel shorter) + (if (font-instance-p newfont) + (if (> (font-instance-width newfont) oldwidth) + (mswindows-find-smaller-font newfont) + newfont)))))) (defun mswindows-make-font-unbold (font &optional device) "Given a mswindows font specification, this attempts to make a non-bold font. @@ -128,18 +135,24 @@ "Given a mswindows font specification, this attempts to make a `bold-italic' font. If it fails, it returns nil." (if (font-instance-p font) - (let ((name (mswindows-font-canicolize-name font))) + (let ((name (mswindows-font-canicolize-name font)) + (oldwidth (font-instance-width font))) (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) - (make-font-instance (concat - (substring name 0 (match-beginning 1)) - "Bold Italic" (substring name (match-end 1))) - device t)))) + (let ((newfont (make-font-instance + (concat (substring name 0 (match-beginning 1)) + "Bold Italic" (substring name (match-end 1))) + device t))) +; Hack! on mswindows, bold fonts (even monospaced) are often wider than the +; equivalent non-bold font. Making the bold font one point smaller usually +; makes it the same width (maybe at the expense of making it one pixel shorter) + (if (font-instance-p newfont) + (if (> (font-instance-width newfont) oldwidth) + (mswindows-find-smaller-font newfont) + newfont)))))) (defun mswindows-find-smaller-font (font &optional device) - "Loads a new, version of the given font (or font name). -Returns the font if it succeeds, nil otherwise. -If scalable fonts are available, this returns a font which is 1 point smaller. -Otherwise, it returns the next smaller version of this font that is defined." + "Loads a new version of the given font (or font name) 1 point smaller. +Returns the font if it succeeds, nil otherwise." (if (font-instance-p font) (let (old-size (name (mswindows-font-canicolize-name font))) (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) @@ -153,10 +166,8 @@ device t))))) (defun mswindows-find-larger-font (font &optional device) - "Loads a new, slightly larger version of the given font (or font name). -Returns the font if it succeeds, nil otherwise. -If scalable fonts are available, this returns a font which is 1 point larger. -Otherwise, it returns the next larger version of this font that is defined." + "Loads a new version of the given font (or font name) 1 point larger. +Returns the font if it succeeds, nil otherwise." (if (font-instance-p font) (let (old-size (name (mswindows-font-canicolize-name font))) (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
--- a/lisp/msw-init.el Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/msw-init.el Mon Aug 13 10:10:02 2007 +0200 @@ -43,20 +43,11 @@ (defun init-post-mswindows-win (console) "Initialize mswindows GUI at startup (post). Don't call this." (unless mswindows-post-win-initted - ;; XXX Add zmacs region hooks here ? - ;; Old-style mswindows bindings. The new-style mswindows bindings ;; (namely Ctrl-X, Ctrl-C and Ctrl-V) are already spoken for by XEmacs. - (define-key global-map '(shift delete) 'mswindows-cut-region) - ; (define-key global-map '(control delete) 'mswindows-delete-region) - (define-key global-map '(shift insert) 'mswindows-paste-region) - (define-key global-map '(control insert) 'mswindows-copy-region) - - ;; Other mswindows style-compliant keys - (define-key global-map '(control z) 'undo) - - ;; Other mswindows style-compliant keys - (define-key global-map '(control z) 'undo) + (define-key global-map '(control insert) 'mswindows-copy-clipboard) + (define-key global-map '(shift insert) 'mswindows-paste-clipboard) + (define-key global-map '(shift delete) 'mswindows-cut-clipboard) ;; Random stuff (define-key global-map 'menu 'popup-mode-menu)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/msw-select.el Mon Aug 13 10:10:02 2007 +0200 @@ -0,0 +1,94 @@ +;;; msw-select.el --- Lisp interface to mswindows selections. + +;; Copyright (C) 1990, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1995 Sun Microsystems. + +;; Maintainer: XEmacs Development Team +;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; This file is dumped with XEmacs (when mswindows support is compiled in). +;; #### Only copes with copying/pasting text + +;;; Code: + +;(defun mswindows-paste-clipboard () +; "Insert the current contents of the Clipboard at point." +; (interactive "*") +; (setq last-command nil) +; (setq this-command 'yank) ; so that yank-pop works. +; (let ((clip (mswindows-get-clipboard))) +; (or clip (error "there is no clipboard selection")) +; (push-mark) +; (insert clip))) + +(defun mswindows-paste-clipboard () + "Insert the current contents of the mswindows clipboard at point, +replacing the active selection if there is one." + (interactive "*") + (setq last-command nil) + (setq this-command 'yank) ; so that yank-pop works. + (let ((clip (mswindows-get-clipboard)) (s (mark-marker)) (e (point-marker))) + (or clip (error "there is no text on the clipboard")) + (if s + (if mouse-track-rectangle-p + (delete-rectangle s e) + (delete-region s e))) + (push-mark) + (if mouse-track-rectangle-p + (insert-rectangle clip) + (insert clip)))) + +(defun mswindows-copy-clipboard () + "Copy the selection to the mswindows clipboard and to the kill ring." + (interactive) + (mswindows-cut-copy-clipboard 'copy)) + +(defun mswindows-cut-clipboard () + "Copy the selection to the mswindows clipboard and to the kill ring, +then delete it." + (interactive "*") + (mswindows-cut-copy-clipboard 'cut)) + +(defun mswindows-cut-copy-clipboard (mode) + "Don't use this function. +Use mswindows-cut-clipboard or mswindows-copy-clipboard instead." + (or (memq mode '(cut copy)) (error "unkown mode %S" mode)) + (setq last-command nil) + (let ((s (mark-marker)) (e (point-marker))) + (if s + (progn + (if mouse-track-rectangle-p + (progn + (setq killed-rectangle (extract-rectangle s e)) + (kill-new (mapconcat 'identity killed-rectangle "\n"))) + (copy-region-as-kill s e)) + (mswindows-set-clipboard (car kill-ring)) + (if (eq mode 'cut) + (if mouse-track-rectangle-p + (delete-rectangle s e) + (delete-region s e)) +;; mswindows apps normally leave the selection active but that feels weird here +;; (setq zmacs-region-stays t) + )) + (error "there is no selection to cut or copy"))))
--- a/lisp/mule/canna-leim.el Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/mule/canna-leim.el Mon Aug 13 10:10:02 2007 +0200 @@ -37,7 +37,9 @@ (require 'canna) (error "Canna is not built into this XEmacs")) (setq inactivate-current-input-method-function 'canna-inactivate) - (canna) + (unless (featurep 'leim-canna-initialized) + (canna) + (provide 'leim-canna-initialized)) (canna-toggle-japanese-mode)) (defun canna-inactivate ()
--- a/lisp/wid-edit.el Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/wid-edit.el Mon Aug 13 10:10:02 2007 +0200 @@ -155,10 +155,14 @@ (defun widget-prettyprint-to-string (object) ;; Like pp-to-string, but uses `cl-prettyprint' - ;; #### FIX ME!!!! (with-current-buffer (get-buffer-create " *widget-tmp*") (erase-buffer) (cl-prettyprint object) + ;; `cl-prettyprint' always surrounds the text with newlines. + (when (eq (char-after (point-min)) ?\n) + (delete-region (point-min) (1+ (point-min)))) + (when (eq (char-before (point-max)) ?\n) + (delete-region (1- (point-max)) (point-max))) (buffer-string))) (defun widget-clear-undo () @@ -3357,10 +3361,7 @@ (let ((pp (if (symbolp value) (prin1-to-string value) (widget-prettyprint-to-string value)))) - (while (string-match "\n\\'" pp) - (setq pp (substring pp 0 -1))) - (if (and (> (length pp) 40) - (not (string-match "\\`\n" pp))) + (if (> (length pp) 40) (concat "\n" pp) pp)))
--- a/lisp/x-toolbar.el Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/x-toolbar.el Mon Aug 13 10:10:02 2007 +0200 @@ -38,7 +38,7 @@ ;; Suppress warning message from bytecompiler (eval-when-compile - (defvar pending-delete)) + (defvar pending-delete-mode)) (defgroup toolbar nil "Configure XEmacs Toolbar functions and properties" @@ -46,8 +46,12 @@ (defun toolbar-not-configured () - (ding) - (message "Configure the item via `M-x customize RET toolbar RET'")) + (interactive) + ;; Note: we don't use `susbtitute-command-keys' here, because + ;; Customize is bound to `C-h C' by default, and that binding is not + ;; familiar to people. This is more descriptive. + (error + "Configure the item via `M-x customize RET toolbar RET'")) (defcustom toolbar-open-function 'find-file "*Function to call when the open icon is selected." @@ -118,8 +122,8 @@ (defun toolbar-paste () (interactive) ;; This horrible kludge is for pending-delete to work correctly. - (and (boundp 'pending-delete) - pending-delete + (and (boundp 'pending-delete-mode) + pending-delete-mode (let ((this-command toolbar-paste-function)) (pending-delete-pre-hook))) (call-interactively toolbar-paste-function)) @@ -150,9 +154,9 @@ (defun toolbar-ispell-internal () (interactive) - (if (region-active-p) - (ispell-region (region-beginning) (region-end)) - (ispell-buffer))) + (if (region-active-p) + (ispell-region (region-beginning) (region-end)) + (ispell-buffer))) (defcustom toolbar-ispell-function 'toolbar-ispell-internal "*Function to call when the ispell icon is selected." @@ -219,7 +223,7 @@ "Run mail in a separate frame." (interactive) (let ((command (cdr (assq toolbar-mail-reader toolbar-mail-commands-alist)))) - (if (not command) + (or command (error "Uknown mail reader %s" toolbar-mail-reader)) (if (symbolp command) (call-interactively command) @@ -229,32 +233,44 @@ ;; toolbar info variables and defuns ;; +(defcustom toolbar-info-use-separate-frame t + "*Whether Info is invoked in a separate frame." + :type 'boolean + :group 'toolbar) + +(defcustom toolbar-info-frame-plist + ;; Info pages are 80 characters wide, so it makes a good default. + `(width 80 ,@(let ((h (plist-get default-frame-plist 'height))) + (and h `(height ,h)))) + "*The properties of the frame in which news is displayed." + :type 'plist + :group 'info) + +(define-obsolete-variable-alias 'Info-frame-plist + 'toolbar-info-frame-plist) + (defvar toolbar-info-frame nil "The frame in which info is displayed.") -(defcustom Info-frame-plist - (append (list 'width 80) - (let ((h (plist-get default-frame-plist 'height))) - (when h (list 'height h)))) - "Frame plist for the Info frame." - :type '(repeat (group :inline t - (symbol :tag "Property") - (sexp :tag "Value"))) - :group 'info) - (defun toolbar-info () "Run info in a separate frame." (interactive) - (if (or (not toolbar-info-frame) - (not (frame-live-p toolbar-info-frame))) - (progn - (setq toolbar-info-frame (make-frame Info-frame-plist)) - (select-frame toolbar-info-frame) - (raise-frame toolbar-info-frame))) - (if (frame-iconified-p toolbar-info-frame) - (deiconify-frame toolbar-info-frame)) - (select-frame toolbar-info-frame) - (raise-frame toolbar-info-frame) + (when toolbar-info-use-separate-frame + (cond ((or (not toolbar-info-frame) + (not (frame-live-p toolbar-info-frame))) + ;; We used to raise frame here, but it's a bad idea, + ;; because raising is a matter of WM policy. However, we + ;; *must* select it, to ensure that the info buffer goes to + ;; the right frame. + (setq toolbar-info-frame (make-frame toolbar-info-frame-plist)) + (select-frame toolbar-info-frame)) + (t + ;; However, if the frame already exists, and the user + ;; clicks on info, it's OK to raise it. + (select-frame toolbar-info-frame) + (raise-frame toolbar-info-frame))) + (when (frame-iconified-p toolbar-info-frame) + (deiconify-frame toolbar-info-frame))) (info)) ;; @@ -269,17 +285,21 @@ (call-interactively 'gdbsrc))) (defvar compile-command) +(defvar toolbar-compile-already-run nil) (defun toolbar-compile () "Run compile without having to touch the keyboard." (interactive) (require 'compile) - (popup-dialog-box - `(,(concat "Compile:\n " compile-command) - ["Compile" (compile compile-command) t] - ["Edit command" compile t] - nil - ["Cancel" (message "Quit") t]))) + (if toolbar-compile-already-run + (compile compile-command) + (setq toolbar-compile-already-run t) + (popup-dialog-box + `(,(concat "Compile:\n " compile-command) + ["Compile" (compile compile-command) t] + ["Edit command" compile t] + nil + ["Cancel" (message "Quit") t])))) ;; ;; toolbar news variables and defuns @@ -331,13 +351,14 @@ (defvar toolbar-news-frame nil "The frame in which news is displayed.") -(defcustom toolbar-news-frame-properties nil +(defcustom toolbar-news-frame-plist nil "*The properties of the frame in which news is displayed." - :type '(repeat (group :inline t - (symbol :tag "Property") - (sexp :tag "Value"))) + :type 'plist :group 'toolbar) +(define-obsolete-variable-alias 'toolbar-news-frame-properties + 'toolbar-news-frame-plist) + (defun toolbar-gnus () "Run Gnus in a separate frame." (interactive) @@ -352,7 +373,6 @@ (delete-frame toolbar-news-frame)) (setq toolbar-news-frame nil)))) (select-frame toolbar-news-frame) - (raise-frame toolbar-news-frame) (gnus)) (when (framep toolbar-news-frame) (when (frame-iconified-p toolbar-news-frame) @@ -361,12 +381,14 @@ (raise-frame toolbar-news-frame)))) (defun toolbar-news () - "Run News (in a separate frame??)." + "Run News." (interactive) (let ((command (assq toolbar-news-reader toolbar-news-commands-alist))) - (if (not command) - (error "Unknown news reader %s" toolbar-news-reader)) - (funcall (cdr command)))) + (or command + (error "Uknown news reader %s" toolbar-news-reader)) + (if (symbolp command) + (call-interactively command) + (eval command)))) (defvar toolbar-last-win-icon nil "A `last-win' icon set.") (defvar toolbar-next-win-icon nil "A `next-win' icon set.")
--- a/nt/ChangeLog Mon Aug 13 10:09:36 2007 +0200 +++ b/nt/ChangeLog Mon Aug 13 10:10:02 2007 +0200 @@ -1,3 +1,10 @@ +Mon December 08 1997 kkm@kis.ru + + * xemacs.mak: added profile.c, removed event-unixod.c + * xemacs.mak: removed dangerous defines _IX_86, _X86_, + _MSC_VER + * config.h: removed #define HAVE_UNIXOID_EVENT_LOOP + Thu December 04 1997 jhar@tardis.ed.ac.uk * xemacs.mak: Define DEBUG_XEMACS when compiling with debug.
--- a/nt/Todo Mon Aug 13 10:09:36 2007 +0200 +++ b/nt/Todo Mon Aug 13 10:10:02 2007 +0200 @@ -23,13 +23,17 @@ strange with X under NT. Has anyone else experiences with this ? # Native GUI issues - 1. Calling mouse_[enter|leave]_frame_hook. - 2. Cut and paste from/to Windows clipboard. - 3. Scrollbar - 4. Menubar - 5. Palette handling - 6. Middle mouse button emulation. - 7. Images + 0. The entire event model. + 1. Calling mouse_[enter|leave]_frame_hook + 2. Can't change bold, italic or bold-italic face fonts + 3. Bogus delay when setting default- or initial-frame-plist + 4. Short timeouts don't seem to be very accurate + 5. Scrollbar + 6. Menubar + 7. Palette handling + 8. Middle mouse button emulation + 9. Drag'n'drop + 10. Images Old Issues.
--- a/nt/config.h Mon Aug 13 10:09:36 2007 +0200 +++ b/nt/config.h Mon Aug 13 10:10:02 2007 +0200 @@ -133,10 +133,7 @@ #define HAVE_WINDOW_SYSTEM #endif -/* Define HAVE_UNIXOID_EVENT_LOOP if we use select() to wait for events. */ -#if defined (HAVE_X_WINDOWS) || defined (HAVE_TTY) || defined (HAVE_MS_WINDOWS) -#define HAVE_UNIXOID_EVENT_LOOP -#endif +/* #define HAVE_UNIXOID_EVENT_LOOP removed -- kkm*/ /* Define USER_FULL_NAME to return a string that is the user's full name.
--- a/nt/xemacs.mak Mon Aug 13 10:09:36 2007 +0200 +++ b/nt/xemacs.mak Mon Aug 13 10:10:02 2007 +0200 @@ -284,6 +284,7 @@ $(XEMACS)\src\frame-msw.c \ $(XEMACS)\src\objects-msw.c \ $(XEMACS)\src\redisplay-msw.c \ + $(XEMACS)\src\select-msw.c \ $(XEMACS)\src\msw-proc.c !endif @@ -385,6 +386,7 @@ $(OUTDIR)\frame-msw.obj \ $(OUTDIR)\objects-msw.obj \ $(OUTDIR)\redisplay-msw.obj \ + $(OUTDIR)\select-msw.obj \ $(OUTDIR)\msw-proc.obj !endif
--- a/src/ChangeLog Mon Aug 13 10:09:36 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 10:10:02 2007 +0200 @@ -1,3 +1,46 @@ +1997-12-08 Kirill M. Katsnelson <kkm@kis.ru> + + * device.h: device::fdin and device::fdout are now defined for + systems which do not HAVE_UNIXOID_EVENT_LOOP. + * device-tty.c, process.c, signal.c: call to signal_fake_event() + bracketed out by #ifdef HAVE_UNIXOID_EVENT_LOOP / #endif + directives. + * signal.c: For Win32 systems, longjmp in signal handler excluded + * nt.c, syssignal.h, systime.h: emulation for SIGALRM and SIGPROF + and setitimer for Win32 platforms. Profiling now works. + * emacs.c: calls to syms_of_profile and vars_of_profile enabled + on Win32 platforms. + * ntproc.c: handling of SIGCHLD now done by the common signal + faking mechanism. (To no avail - subprocesses still broken) + * s/windowsnt.h: Signal constants added + * redisplay-msw.c: "Sticky" beep which blocked XEmacs until the + sound finishes is now repaired + +1997-12-06 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * frame-msw.c, msw-proc.c + Further changes to resizing code so that changing default + font, either in .emacs or later, works properly. + + * msw-proc.c + Minor optimization: Mouse movement events aren't generated + while the user is resizing the frame. + Function keys are returned lower-case. + +1997-12-09 P. E. Jareth Hein <jareth@camelot-soft.com> + + * glyphs-x.c (imagick_instantiate): fix it so that it works + properly for PseudoClass files. Still needs some thinking for + full color... Also added support for old image instantiators + in various places using the OLDCOMPAT define + +1997-12-08 Kyle Jones <kyle_jones@wonderworks.com> + + * event-stream.c (Faccelerate_menu): Check for the + existence of a menubar associated with the selected frame + before trying to use it. Signal an error if there is + no menubar. + 1997-12-06 P E Jareth Hein <jareth@camelot-soft.com> * device-x.c: Change -privcmap to -privatecolormap.
--- a/src/emacs.c Mon Aug 13 10:09:36 2007 +0200 +++ b/src/emacs.c Mon Aug 13 10:10:02 2007 +0200 @@ -883,6 +883,7 @@ syms_of_event_mswindows (); syms_of_frame_mswindows (); syms_of_objects_mswindows (); + syms_of_select_mswindows (); #endif #ifdef MULE @@ -1210,6 +1211,7 @@ vars_of_event_mswindows (); vars_of_frame_mswindows (); vars_of_objects_mswindows (); + vars_of_select_mswindows (); #endif #ifdef MULE
--- a/src/event-stream.c Mon Aug 13 10:09:36 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 10:10:02 2007 +0200 @@ -3009,7 +3009,7 @@ return event_binding (event0, 1); } -#if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBARS_LUCID) +#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) static void menu_move_up (void) { @@ -3495,9 +3495,14 @@ { struct console *con = XCONSOLE (Vselected_console); struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); - LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; - widget_value *val = lw_get_all_values (id); - + LWLIB_ID id; + widget_value *val; + + if (NILP (f->menubar_data)) + error ("Frame has no menubar."); + + id = XPOPUP_DATA (f->menubar_data)->id; + val = lw_get_all_values (id); val = val->contents; lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val); lw_map_menu (CurrentTime); @@ -3634,7 +3639,7 @@ } /* if we're currently in a menu accelerator, check there for further events */ -#if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBARS_LUCID) +#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) if (lw_menu_active) { return command_builder_operate_menu_accelerator (builder); @@ -3647,7 +3652,7 @@ if (NILP (result)) #endif result = command_builder_find_leaf_1 (builder); -#if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBARS_LUCID) +#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) if (NILP (result) && EQ (Vmenu_accelerator_enabled, Qmenu_fallback)) result = command_builder_find_menu_accelerator (builder); @@ -4853,7 +4858,7 @@ DEFSUBR (Fthis_command_keys); DEFSUBR (Freset_this_command_lengths); DEFSUBR (Fopen_dribble_file); -#if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBARS_LUCID) +#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) DEFSUBR (Faccelerate_menu); #endif
--- a/src/frame-msw.c Mon Aug 13 10:09:36 2007 +0200 +++ b/src/frame-msw.c Mon Aug 13 10:10:02 2007 +0200 @@ -69,13 +69,6 @@ static void mswindows_init_frame_2 (struct frame *f, Lisp_Object props) { - int x, y; - Lisp_Object frame, window; - - XSETFRAME (frame, f); - default_face_height_and_width (frame, &x, &y); - FRAME_PIXWIDTH(f) = x * FRAME_WIDTH(f); - FRAME_PIXHEIGHT(f) = y * FRAME_HEIGHT(f); } /* Called after frame's properties are set */
--- a/src/glyphs-x.c Mon Aug 13 10:09:36 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 10:10:02 2007 +0200 @@ -60,6 +60,8 @@ #include <magick/magick.h> /*#include <image.h>*/ #include <assert.h> + +#define OLDCOMPAT /* allow lisp code using the old names to still function */ #endif #define LISP_DEVICE_TO_X_SCREEN(dev) \ @@ -85,6 +87,17 @@ #ifdef HAVE_IMAGEMAGICK DEFINE_IMAGE_INSTANTIATOR_FORMAT (imagick); Lisp_Object Qimagick; + +#ifdef OLDCOMPAT /* old compatibility */ +DEFINE_IMAGE_INSTANTIATOR_FORMAT (tiff); +DEFINE_IMAGE_INSTANTIATOR_FORMAT (png); +DEFINE_IMAGE_INSTANTIATOR_FORMAT (gif); +DEFINE_IMAGE_INSTANTIATOR_FORMAT (jpeg); +Lisp_Object Qtiff; +Lisp_Object Qpng; +Lisp_Object Qgif; +Lisp_Object Qjpeg; +#endif #endif DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font); @@ -1680,8 +1693,8 @@ struct imagick_unwind_data { - /* FIXME - what goes here...*/ Display *dpy; + Colormap cmap; FILE *instream; Image *image; XImage *ximage; @@ -1707,15 +1720,18 @@ DestroyImage(data->image); } - if (data->ximage) - { - if (data->ximage->data) - { + if (data->ximage) { + if (data->ximage->data) { xfree (data->ximage->data); data->ximage->data = NULL; } XDestroyImage (data->ximage); } + + if (data->npixels > 0) { + XFreeColors(data->dpy, data->cmap, data->pixels, data->npixels, 0L); + xfree (data->pixels); + } return Qnil; } @@ -1725,166 +1741,185 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - Display *dpy; - Screen *scr; - Visual *visual; - Dimension depth; - struct imagick_unwind_data unwind; - int speccount = specpdl_depth (); - ImageInfo image_info; - - /* ImageMagick variables */ - - /* Basic error checking */ - if (!DEVICE_X_P (XDEVICE (device))) - signal_simple_error ("Not an X device", device); - - dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - scr = DefaultScreenOfDisplay (dpy); - depth = DEVICE_X_DEPTH (XDEVICE (device)); - visual = DEVICE_X_VISUAL (XDEVICE (device)); - - /* Set up the unwind */ - memset (&unwind, 0, sizeof (unwind)); - unwind.dpy = dpy; - record_unwind_protect(imagick_instantiate_unwind,make_opaque_ptr(&unwind)); - - /* Write out to a temp file - not sure if ImageMagick supports the - ** notion of an abstrat 'data source' right now. - */ - { - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - - assert (!NILP (data)); - - write_lisp_string_to_temp_file (data, unwind.tempfile); - unwind.tempfile_needs_to_be_removed = 1; - - if ((unwind.instream = fopen (unwind.tempfile, "rb")) == NULL) - report_file_error ("Opening ImageMagick temp file", - list1 (build_string (unwind.tempfile))); - } - - /* Initialize structures and read in the image */ - GetImageInfo(&image_info); - strcpy(image_info.filename,unwind.tempfile); - unwind.image = ReadImage(&image_info); - if (unwind.image == (Image *) NULL) { - signal_simple_error ("Unable to read image.",instantiator); - } + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); + Display *dpy; + Screen *scr; + Visual *visual; + Colormap cmap; + Dimension depth; + struct imagick_unwind_data unwind; + int speccount = specpdl_depth (); + ImageInfo image_info; + + /* ImageMagick variables */ + + /* Basic error checking */ + if (!DEVICE_X_P (XDEVICE (device))) + signal_simple_error ("Not an X device", device); + + dpy = DEVICE_X_DISPLAY (XDEVICE (device)); + scr = DefaultScreenOfDisplay (dpy); + depth = DEVICE_X_DEPTH (XDEVICE (device)); + visual = DEVICE_X_VISUAL (XDEVICE (device)); + cmap = DEVICE_X_COLORMAP (XDEVICE(device)); + + /* Set up the unwind */ + memset (&unwind, 0, sizeof (unwind)); + unwind.dpy = dpy; + unwind.cmap = cmap; + record_unwind_protect(imagick_instantiate_unwind,make_opaque_ptr(&unwind)); + + /* Write out to a temp file - not sure if ImageMagick supports the + ** notion of an abstract 'data source' right now. + ** JH: It doesn't as of 3.9.3 + */ + { + Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); + + assert (!NILP (data)); + + write_lisp_string_to_temp_file (data, unwind.tempfile); + unwind.tempfile_needs_to_be_removed = 1; + + if ((unwind.instream = fopen (unwind.tempfile, "rb")) == NULL) + report_file_error ("Opening ImageMagick temp file", + list1 (build_string (unwind.tempfile))); + } + + /* Initialize structures and read in the image */ + GetImageInfo(&image_info); + strcpy(image_info.filename,unwind.tempfile); + unwind.image = ReadImage(&image_info); + + if (unwind.image == (Image *) NULL) { + signal_simple_error ("Unable to read image.",instantiator); + } #if 1 - DescribeImage(unwind.image,stderr,1); + /* + * For now, force dithering everything, and deal with all images as if they + * were PseudoClass images + */ + if (unwind.image->class != PseudoClass) { + QuantizeInfo quantize_info; + GetQuantizeInfo(&quantize_info); + quantize_info.number_colors=256; + quantize_info.tree_depth=8; + quantize_info.dither=True; + quantize_info.colorspace=RGBColorspace; + QuantizeImage(&quantize_info, unwind.image); + SyncImage(unwind.image); + /* #### It would probably be a good idea to sort the colormap by popularity, + * so that in case we run out of entries in the map, it will likely be on + * the less used colors + */ + } else { + CompressColormap(unwind.image); + SyncImage(unwind.image); + } + +#endif + +#if 0 + DescribeImage(unwind.image,stderr,1); #endif - unwind.ximage = XCreateImage(dpy, visual, depth, - (depth == 1) ? XYPixmap : ZPixmap, - 0, 0, - unwind.image->columns, - unwind.image->rows, - XBitmapPad(dpy), 0); - - if (!unwind.ximage) { - signal_simple_error("Unable to allocate XImage structure", - instantiator); - } - - unwind.ximage->data = (char *) xmalloc(unwind.ximage->bytes_per_line * - unwind.ximage->height * - unwind.ximage->depth); - - if (unwind.ximage->data == (char *)NULL) { - signal_simple_error("Unable to allocate pixel information", - instantiator); - } - - /* Need to pull the data from the 'Image' structure in - ** unwind.image and convert it to an 'XImage' in unwind.ximage - ** - ** FIXME IM FUCKED - ** - ** WMP 10/30/97 - */ - + unwind.ximage = XCreateImage(dpy, visual, depth, + (depth == 1) ? XYPixmap : ZPixmap, + 0, 0, + unwind.image->columns, + unwind.image->rows, + XBitmapPad(dpy), 0); + + if (!unwind.ximage) { + signal_simple_error("Unable to allocate XImage structure", + instantiator); + } + + unwind.ximage->data = (char *) xmalloc(unwind.ximage->bytes_per_line * + unwind.ximage->height); + + if (unwind.ximage->data == (char *)NULL) { + signal_simple_error("Unable to allocate XImage data information", + instantiator); + } + + + /* + ** First pull out all of the colors used, and create a lookup for them + */ + + if (unwind.image->class == PseudoClass) { + int i; + + unwind.npixels = unwind.image->colors; + unwind.pixels = xmalloc(unwind.npixels * sizeof(unsigned long)); + for (i = 0; i < unwind.npixels; i++) { + XColor color; + /* ImageMagic uses 8bit values for colors, whilst X expects 16bits */ + color.red = unwind.image->colormap[i].red << 8; + color.green = unwind.image->colormap[i].green << 8; + color.blue = unwind.image->colormap[i].blue << 8; + color.flags = DoRed | DoGreen | DoBlue; + allocate_nearest_color (dpy, cmap, visual, &color); + unwind.pixels[i] = color.pixel; + } + } + + /* + ** Need to pull the data from the 'Image' structure in + ** unwind.image and convert it to an 'XImage' in unwind.ximage + */ + { + int i,j,x,b; + unsigned int bytes_per_pixel, scanline_pad; + unsigned long pixval; + unsigned char *q; + RunlengthPacket *p; + + q = (unsigned char *) unwind.ximage->data; + x = 0; + p = unwind.image->pixels; + scanline_pad = unwind.ximage->bytes_per_line - + ((unwind.ximage->width * unwind.ximage->bits_per_pixel) >> 3); + + /* Convert to multi-byte color-mapped X image. */ + bytes_per_pixel=unwind.ximage->bits_per_pixel >> 3; + + for (i=0; i < unwind.image->packets; i++) { + if (unwind.image->class == PseudoClass) + pixval = unwind.pixels[p->index]; + else { - int i,j,x; - unsigned int bytes_per_pixel, scanline_pad; - unsigned char *q; - RunlengthPacket *p; - XColor color; - - unwind.npixels = unwind.image->total_colors; - unwind.pixels = xmalloc(unwind.npixels * sizeof(unsigned long)); - q = (unsigned char *) unwind.ximage->data; - x = 0; - memset(unwind.pixels,0,unwind.npixels * sizeof(unsigned long)); - p = unwind.image->pixels; - scanline_pad = unwind.ximage->bytes_per_line - - ((unwind.ximage->width * unwind.ximage->bits_per_pixel) >> 3); - - /* Convert to multi-byte color-mapped X image. */ - bytes_per_pixel=unwind.ximage->bits_per_pixel >> 3; - -#if 1 - for (i=0; i < unwind.image->packets; i++) - { - color.red = p->red; - color.green = p->green; - color.blue = p->blue; - color.flags = DoRed | DoGreen | DoBlue; - allocate_nearest_color (dpy, DefaultColormapOfScreen (scr), visual, &color); - unwind.pixels[i] = color.pixel; - - for (j=0; j <= ((int) p->length); j++) - { - *q++=(unsigned char) color.pixel; - x++; - if (x == unwind.ximage->width) - { - x=0; - q+=scanline_pad; - } - } - p++; - } -#else - for (i=0; i < unwind.image->packets; i++) - { - pixel = unwind.pixels[p->index]; - for (k=0; k < bytes_per_pixel; k++) - { - channel[k]=(unsigned char) pixel; - pixel>>=8; - } - for (j=0; j <= ((int) p->length); j++) - { - for (k=0; k < bytes_per_pixel; k++) - *q++=channel[k]; - x++; - if (x == unwind.ximage->width) - { - x=0; - q+=scanline_pad; - } - } - p++; - } -#endif + /* ### NOW what? */ + pixval = 0; + } + + for (j=0; j <= ((int) p->length); j++) { + for (b=0; b < bytes_per_pixel; b++) + *q++=(unsigned char) (pixval >> (8*b)); + x++; + if (x == unwind.ximage->width) { + x=0; + q+=scanline_pad; } - - init_image_instance_from_x_image (ii, unwind.ximage, dest_mask, - unwind.pixels, unwind.npixels, - instantiator); - - /* And we are done! - ** Now that we've succeeded, we don't want the pixels - ** freed right now. They're kept around in the image instance - ** structure until it's destroyed. - */ - unwind.npixels = 0; - unbind_to (speccount, Qnil); + } + p++; + } + } + + init_image_instance_from_x_image (ii, unwind.ximage, dest_mask, + unwind.pixels, unwind.npixels, + instantiator); + + /* And we are done! + ** Now that we've succeeded, we don't want the pixels + ** freed right now. They're kept around in the image instance + ** structure until it's destroyed. + */ + unwind.npixels = 0; + unbind_to (speccount, Qnil); } #endif /* HAVE_IMAGEMAGICK */ @@ -2804,6 +2839,45 @@ IIFORMAT_VALID_KEYWORD (imagick, Q_data, check_valid_string); IIFORMAT_VALID_KEYWORD (imagick, Q_file, check_valid_string); + +#ifdef OLDCOMPAT /* old graphics compatibility */ +#define IIFORMAT_USES_METHOD(format, source, m) \ + (format##_image_instantiator_methods->m##_method = source##_##m) + + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tiff, "tiff"); + IIFORMAT_USES_METHOD (tiff, imagick, validate); + IIFORMAT_USES_METHOD (tiff, imagick, normalize); + IIFORMAT_USES_METHOD (tiff, imagick, possible_dest_types); + IIFORMAT_USES_METHOD (tiff, imagick, instantiate); + IIFORMAT_VALID_KEYWORD (tiff, Q_data, check_valid_string); + IIFORMAT_VALID_KEYWORD (tiff, Q_file, check_valid_string); + + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (png, "png"); + IIFORMAT_USES_METHOD (png, imagick, validate); + IIFORMAT_USES_METHOD (png, imagick, normalize); + IIFORMAT_USES_METHOD (png, imagick, possible_dest_types); + IIFORMAT_USES_METHOD (png, imagick, instantiate); + IIFORMAT_VALID_KEYWORD (png, Q_data, check_valid_string); + IIFORMAT_VALID_KEYWORD (png, Q_file, check_valid_string); + + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (gif, "gif"); + IIFORMAT_USES_METHOD (gif, imagick, validate); + IIFORMAT_USES_METHOD (gif, imagick, normalize); + IIFORMAT_USES_METHOD (gif, imagick, possible_dest_types); + IIFORMAT_USES_METHOD (gif, imagick, instantiate); + IIFORMAT_VALID_KEYWORD (gif, Q_data, check_valid_string); + IIFORMAT_VALID_KEYWORD (gif, Q_file, check_valid_string); + + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (jpeg, "jpeg"); + IIFORMAT_USES_METHOD (jpeg, imagick, validate); + IIFORMAT_USES_METHOD (jpeg, imagick, normalize); + IIFORMAT_USES_METHOD (jpeg, imagick, possible_dest_types); + IIFORMAT_USES_METHOD (jpeg, imagick, instantiate); + IIFORMAT_VALID_KEYWORD (jpeg, Q_data, check_valid_string); + IIFORMAT_VALID_KEYWORD (jpeg, Q_file, check_valid_string); + +#endif /* old compat */ + #endif #ifdef HAVE_XPM @@ -2868,6 +2942,13 @@ #ifdef HAVE_IMAGEMAGICK Fprovide (Qimagick); + +#ifdef OLDCOMPAT + Fprovide (Qtiff); + Fprovide (Qpng); + Fprovide (Qgif); + Fprovide (Qjpeg); +#endif #endif #ifdef HAVE_XFACE
--- a/src/msw-proc.c Mon Aug 13 10:09:36 2007 +0200 +++ b/src/msw-proc.c Mon Aug 13 10:10:02 2007 +0200 @@ -205,6 +205,7 @@ Lisp_Object emacs_event; struct Lisp_Event *event; + static sizing = 0; MSG msg = { hwnd, message, wParam, lParam, 0, {0,0} }; msg.time = GetMessageTime(); @@ -316,6 +317,8 @@ break; case WM_MOUSEMOVE: + /* Optimization: don't report mouse movement while size is changind */ + if (!sizing) { short x, y; @@ -443,6 +446,11 @@ } break; + case WM_ENTERSIZEMOVE: + case WM_EXITSIZEMOVE: + sizing = (message == WM_ENTERSIZEMOVE); + goto defproc; + defproc: default: return DefWindowProc (hwnd, message, wParam, lParam); @@ -496,11 +504,14 @@ style = (NILP(popup)) ? MSWINDOWS_FRAME_STYLE : MSWINDOWS_POPUP_STYLE; - rect.left = INTP(left) ? XINT(left) : 0; - rect.top = INTP(top) ? XINT(top) : 0; - char_to_pixel_size (f, INTP(width) ? XINT(width) : 80, - INTP(height) ? XINT(height) : 24, - &rect.right, &rect.bottom); + FRAME_WIDTH (f) = INTP(width) ? XINT(width) : 80; + FRAME_HEIGHT (f) = INTP(height) ? XINT(height) : 30; + char_to_pixel_size (f, FRAME_WIDTH(f), FRAME_HEIGHT (f), + &FRAME_PIXWIDTH (f), &FRAME_PIXHEIGHT (f)); + + rect.left = rect.top = 0; + rect.right = FRAME_PIXWIDTH (f); + rect.bottom = FRAME_PIXHEIGHT (f); #ifdef HAVE_MENUBARS AdjustWindowRect(&rect, style, TRUE); #else @@ -605,30 +616,30 @@ case VK_RWIN return KEYSYM (""); #endif case VK_APPS: return KEYSYM ("menu"); - case VK_F1: return KEYSYM ("F1"); - case VK_F2: return KEYSYM ("F2"); - case VK_F3: return KEYSYM ("F3"); - case VK_F4: return KEYSYM ("F4"); - case VK_F5: return KEYSYM ("F5"); - case VK_F6: return KEYSYM ("F6"); - case VK_F7: return KEYSYM ("F7"); - case VK_F8: return KEYSYM ("F8"); - case VK_F9: return KEYSYM ("F9"); - case VK_F10: return KEYSYM ("F10"); - case VK_F11: return KEYSYM ("F11"); - case VK_F12: return KEYSYM ("F12"); - case VK_F13: return KEYSYM ("F13"); - case VK_F14: return KEYSYM ("F14"); - case VK_F15: return KEYSYM ("F15"); - case VK_F16: return KEYSYM ("F16"); - case VK_F17: return KEYSYM ("F17"); - case VK_F18: return KEYSYM ("F18"); - case VK_F19: return KEYSYM ("F19"); - case VK_F20: return KEYSYM ("F20"); - case VK_F21: return KEYSYM ("F21"); - case VK_F22: return KEYSYM ("F22"); - case VK_F23: return KEYSYM ("F23"); - case VK_F24: return KEYSYM ("F24"); + case VK_F1: return KEYSYM ("f1"); + case VK_F2: return KEYSYM ("f2"); + case VK_F3: return KEYSYM ("f3"); + case VK_F4: return KEYSYM ("f4"); + case VK_F5: return KEYSYM ("f5"); + case VK_F6: return KEYSYM ("f6"); + case VK_F7: return KEYSYM ("f7"); + case VK_F8: return KEYSYM ("f8"); + case VK_F9: return KEYSYM ("f9"); + case VK_F10: return KEYSYM ("f10"); + case VK_F11: return KEYSYM ("f11"); + case VK_F12: return KEYSYM ("f12"); + case VK_F13: return KEYSYM ("f13"); + case VK_F14: return KEYSYM ("f14"); + case VK_F15: return KEYSYM ("f15"); + case VK_F16: return KEYSYM ("f16"); + case VK_F17: return KEYSYM ("f17"); + case VK_F18: return KEYSYM ("f18"); + case VK_F19: return KEYSYM ("f19"); + case VK_F20: return KEYSYM ("f20"); + case VK_F21: return KEYSYM ("f21"); + case VK_F22: return KEYSYM ("f22"); + case VK_F23: return KEYSYM ("f23"); + case VK_F24: return KEYSYM ("f24"); default: /* Special handling for Ctrl-'@' because '@' lives shifted on varying * virtual keys and because Windows doesn't report Ctrl-@ as a WM_CHAR */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/select-msw.c Mon Aug 13 10:10:02 2007 +0200 @@ -0,0 +1,162 @@ +/* mswindows selection processing for XEmacs + Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. + +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 synched with FSF. */ + +/* Authorship: + + Written by Kevin Gallo for FSF Emacs. + Rewritten for mswindows by Jonathan Harris, December 1997 for 20.4. + */ + + +#include <config.h> +#include "lisp.h" + +#include "console-msw.h" + +DEFUN ("mswindows-set-clipboard", Fmswindows_set_clipboard, 1, 1, 0, /* +Copy STRING to the mswindows clipboard. +*/ + (string)) +{ + int rawsize, size, i; + unsigned char *src, *dst, *next; + HGLOBAL h = NULL; + + CHECK_STRING (string, 0); + + /* Calculate size with LFs converted to CRLFs because + * CF_TEXT format uses CRLF delimited ASCIIZ */ + src = XSTRING_DATA (string); + size = rawsize = XSTRING_LENGTH (string) + 1; + for (i=0; i<rawsize; i++) + if (src[i] == '\n') + size++; + + if (!OpenClipboard (NULL)) + return Qnil; + + if (!EmptyClipboard () || + (h = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, size)) == NULL || + (dst = (unsigned char *) GlobalLock (h)) == NULL) + { + if (h != NULL) GlobalFree (h); + CloseClipboard (); + return Qnil; + } + + /* Convert LFs to CRLFs */ + do + { + /* copy next line or remaining bytes including '\0' */ + next = memccpy (dst, src, '\n', rawsize); + if (next) + { + /* copied one line ending with '\n' */ + int copied = next - dst; + rawsize -= copied; + src += copied; + /* insert '\r' before '\n' */ + next[-1] = '\r'; + next[0] = '\n'; + dst = next+1; + } + } + while (next); + + GlobalUnlock (h); + + i = SetClipboardData (CF_TEXT, h); + + CloseClipboard (); + GlobalFree (h); + + return i ? Qt : Qnil; +} + +DEFUN ("mswindows-get-clipboard", Fmswindows_get_clipboard, 0, 0, 0, /* +Return the contents of the mswindows clipboard. +*/ + ()) +{ + HANDLE h; + unsigned char *src, *dst, *next; + Lisp_Object ret = Qnil; + + if (!OpenClipboard (NULL)) + return Qnil; + + if ((h = GetClipboardData (CF_TEXT)) != NULL && + (src = (unsigned char *) GlobalLock (h)) != NULL) + { + int i; + int size, rawsize; + size = rawsize = strlen (src); + + for (i=0; i<rawsize; i++) + if (src[i] == '\r' && src[i+1] == '\n') + size--; + + /* Convert CRLFs to LFs */ + ret = make_uninit_string (size); + dst = XSTRING_DATA (ret); + do + { + /* copy next line or remaining bytes excluding '\0' */ + next = _memccpy (dst, src, '\r', rawsize); + if (next) + { + /* copied one line ending with '\r' */ + int copied = next - dst; + rawsize -= copied; + src += copied; + if (*src == '\n') + dst += copied - 1; /* overwrite '\r' */ + else + dst += copied; + } + } + while (next); + + GlobalUnlock (h); + } + + CloseClipboard (); + + return ret; +} + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_select_mswindows (void) +{ + DEFSUBR (Fmswindows_set_clipboard); + DEFSUBR (Fmswindows_get_clipboard); +} + +void +vars_of_select_mswindows (void) +{ +}
--- a/src/symsinit.h Mon Aug 13 10:09:36 2007 +0200 +++ b/src/symsinit.h Mon Aug 13 10:10:02 2007 +0200 @@ -120,6 +120,7 @@ void syms_of_redisplay (void); void syms_of_scrollbar (void); void syms_of_search (void); +void syms_of_select_mswindows (void); void syms_of_signal (void); void syms_of_sound (void); void syms_of_specifier (void); @@ -259,6 +260,7 @@ void vars_of_scrollbar_x (void); void vars_of_scrollbar (void); void vars_of_search (void); +void vars_of_select_mswindows (void); void vars_of_sound (void); void vars_of_specifier (void); void vars_of_sunpro (void);