From: tomo Date: Mon, 17 May 1999 09:41:42 +0000 (+0000) Subject: XEmacs 21.2.7 X-Git-Tag: r21-2-7~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=cb9f6f4eadc44f1becb32cbbd1db26449e347755;p=chise%2Fxemacs-chise.git.1 XEmacs 21.2.7 --- diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 7afb38a..099f980 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,16 @@ +1998-12-24 Martin Buchholz + + * XEmacs 21.2.7 is released. + +1998-12-17 Andy Piper + + * pop.c (pop_open): disable use of getpass() which doesn't exist under NT. + + * movemail.c: mess with includes so that it builds under native NT. + + * pop.c: mess with includes so that it builds under native NT. + From Fabrice Popineau + 1998-12-16 Andy Piper * XEmacs 21.2.6 is released diff --git a/lib-src/movemail.c b/lib-src/movemail.c index ac257d9..fd578c0 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -55,14 +55,18 @@ Boston, MA 02111-1307, USA. */ */ #define NO_SHORTNAMES /* Tell config not to load remap.h */ +#define DONT_ENCAPSULATE #include <../src/config.h> #include #include #include #include #include +#include "../src/sysfile.h" #include "../src/syswait.h" +#ifndef WINDOWSNT #include "../src/systime.h" +#endif #include #include #include "getopt.h" @@ -305,7 +309,9 @@ main (int argc, char *argv[]) exit (retcode); } +#ifndef WINDOWSNT setuid (getuid ()); +#endif #endif /* MAIL_USE_POP */ #ifndef DISABLE_DIRECT_ACCESS @@ -632,7 +638,7 @@ popmail (char *user, char *outfile, char *password) error ("Error in open: %s, %s", strerror (errno), outfile); return (1); } -#ifndef __CYGWIN32__ +#if !defined(__CYGWIN32__) && !defined(WINDOWSNT) fchown (mbfi, getuid (), -1); #endif diff --git a/lib-src/pop.c b/lib-src/pop.c index 728d1ca..bbec8ab 100644 --- a/lib-src/pop.c +++ b/lib-src/pop.c @@ -38,7 +38,6 @@ Boston, MA 02111-1307, USA. */ #include #ifdef WINDOWSNT -#include "ntlib.h" #include #undef SOCKET_ERROR #define RECV(s,buf,len,flags) recv(s,buf,len,flags) @@ -77,7 +76,9 @@ extern struct servent *hes_getservbyname (/* char *, char * */); #include #include #include "../src/syswait.h" +#ifndef WINDOWSNT #include "../src/systime.h" +#endif #include #include @@ -183,6 +184,7 @@ pop_open (char *host, char *username, char *password, int flags) username = getenv ("USER"); if (! (username && *username)) { +#ifndef WINDOWSNT username = getlogin (); if (! (username && *username)) { @@ -198,6 +200,10 @@ pop_open (char *host, char *username, char *password, int flags) return (0); } } +#else + strcpy (pop_error, "Could not determine username"); + return (0); +#endif } } @@ -247,10 +253,12 @@ pop_open (char *host, char *username, char *password, int flags) if ((! password) && (! DONT_NEED_PASSWORD)) { +#ifndef WINDOWSNT if (! (flags & POP_NO_GETPASS)) { password = getpass ("Enter POP password:"); } +#endif if (! password) { strcpy (pop_error, "Could not determine POP password"); diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1eeca12..80077b5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,46 @@ +1998-12-24 Martin Buchholz + + * XEmacs 21.2.7 is released. + +1998-12-07 Jan Vroonhof + + * package-ui.el (pui-list-packages): Set truncate-lines. + + * package-get.el (package-get-download-menu): Use + `package-ui-add-site'. Add a a toggle to indicate it is in the list. + + * package-ui.el (pui-help): Ditch in favor of `describe-mode' + (pui-help-string): idem. + (list-packages-mode): New major mode. + (pui-list-packages): Use 'list-packages-mode' in the package buffer. + (pui-install-selected-packages): Add suport for removing packages. + (pui-toggle-package-delete-key): New function. + (pui-popup-context-sensitive): New kludge. + (pui-list-packages): Add warning when `package-get-remote' is nil. + (package-ui-add-site): New function. + +1998-12-01 Didier Verna + + * hyper-apropos.el (hyper-where-is): added the missing autoload. + +1998-11-29 Oscar Figueiredo + + * ldap.el: Custom-ized + (toplevel): Do not provide `ldap' which is provided by C level + LDAP code + (ldap-search): Docstring and stylistic fixes as suggested by Hrvoje + +1998-12-05 Hrvoje Niksic + + * isearch-mode.el (isearch-mode): Really fix keymap lossage. + +1998-12-17 Andy Piper + + * sound.el (sound-load-list): name changed from sound-load-alist. + (sound-extension-list): name changed from sound-ext-list. + (load-default-sounds): use new names. + (load-sound-file): use new names. + 1998-12-16 Andy Piper * XEmacs 21.2.6 is released diff --git a/lisp/glyphs.el b/lisp/glyphs.el index 6594006..08a791a 100644 --- a/lisp/glyphs.el +++ b/lisp/glyphs.el @@ -603,6 +603,10 @@ If unspecified in a particular domain, `nontext-pointer-glyph' is used.") ;;; (defvar x-toolbar-pointer-shape nil) (define-obsolete-pointer-glyph 'x-toolbar-pointer-shape 'toolbar-pointer-glyph) +;; for subwindows +(defalias 'subwindow-xid 'image-instance-subwindow-id) +(defalias 'subwindow-width 'image-instance-width) +(defalias 'subwindow-height 'image-instance-height) ;;;;;;;;;; initialization (defun init-glyphs () diff --git a/lisp/hyper-apropos.el b/lisp/hyper-apropos.el index 699e4fc..1e34bfa 100644 --- a/lisp/hyper-apropos.el +++ b/lisp/hyper-apropos.el @@ -481,6 +481,7 @@ See also `hyper-apropos' and `hyper-describe-function'." (setq hyper-apropos-prev-wconfig (current-window-configuration))) (hyper-apropos-get-doc symbol t nil this-ref-buffer))) +;;;###autoload (defun hyper-where-is (symbol) "Print message listing key sequences that invoke specified command." (interactive (list (hyper-apropos-read-function-symbol "Where is function"))) diff --git a/lisp/isearch-mode.el b/lisp/isearch-mode.el index 8a611f2..cc5b3fa 100644 --- a/lisp/isearch-mode.el +++ b/lisp/isearch-mode.el @@ -455,15 +455,16 @@ is treated as a regexp. See \\[isearch-forward] for more info." ;; #### Should we remember the old value of ;; overriding-local-map? - overriding-local-map isearch-mode-map + overriding-local-map (progn + (set-keymap-parents isearch-mode-map + (nconc (current-minor-mode-maps) + (and (current-local-map) + (list (current-local-map))))) + isearch-mode-map) isearch-selected-frame (selected-frame) isearch-mode (gettext " Isearch") ) - (let ((map (append (current-minor-mode-maps) - (list (current-local-map))))) - (if (keymapp map) - (set-keymap-parents isearch-mode-map map))) ;; XEmacs change: without clearing the match data, sometimes old values ;; of isearch-other-end get used. Don't ask me why... diff --git a/lisp/ldap.el b/lisp/ldap.el index 1f09377..7a06c6a 100644 --- a/lisp/ldap.el +++ b/lisp/ldap.el @@ -5,7 +5,7 @@ ;; Author: Oscar Figueiredo ;; Maintainer: Oscar Figueiredo ;; Created: Jan 1998 -;; Version: $Revision: 1.7.2.1 $ +;; Version: $Revision: 1.7.2.2 $ ;; Keywords: help comm ;; This file is part of XEmacs @@ -35,17 +35,42 @@ ;;; Code: -(eval-when '(load eval) - (require 'ldap)) - -(defvar ldap-default-host nil - "*Default LDAP server.") - -(defvar ldap-host-parameters-alist nil - "*An alist of per host options for LDAP transactions -The list elements look like (HOST PROP1 VAL1 PROP2 VAL2 ...) -HOST is the name of an LDAP server. PROPn and VALn are property/value pairs -describing parameters for the server. Valid properties: +(require 'ldap) +(require 'custom) + +(defgroup ldap nil + "Lightweight Directory Access Protocol" + :group 'comm) + +(defcustom ldap-default-host nil + "*Default LDAP server." + :type '(choice (string :tag "Host name") + (const :tag "Use library default" nil)) + :group 'ldap) + +(defcustom ldap-default-port nil + "*Default TCP port for LDAP connections. +Initialized from the LDAP library at build time. Default value is 389." + :type '(choice (const :tag "Use library default" nil) + (integer :tag "Port number")) + :group 'ldap) + +(defcustom ldap-default-base nil + "*Default base for LDAP searches. +This is a string using the syntax of RFC 1779. +For instance, \"o=ACME, c=US\" limits the search to the +Acme organization in the United States." + :type '(choice (const :tag "Use library default" nil) + (string :tag "Search base")) + :group 'ldap) + + +(defcustom ldap-host-parameters-alist nil + "*Alist of host-specific options for LDAP transactions. +The format of each list element is: +\(HOST PROP1 VAL1 PROP2 VAL2 ...) +HOST is the name of an LDAP server. PROPn and VALn are property/value +pairs describing parameters for the server. Valid properties include: `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). `passwd' is the password to use for simple authentication. @@ -55,39 +80,95 @@ describing parameters for the server. Valid properties: `scope' is one of the three symbols `subtree', `base' or `onelevel'. `deref' is one of the symbols `never', `always', `search' or `find'. `timelimit' is the timeout limit for the connection in seconds. - `sizelimit' is the maximum number of matches to return." ) + `sizelimit' is the maximum number of matches to return." + :type '(repeat :menu-tag "Host parameters" + :tag "Host parameters" + (list :menu-tag "Host parameters" + :tag "Host parameters" + :value nil + (string :tag "Host name") + (checklist :inline t + :greedy t + (list + :tag "Binding DN" + :inline t + (const :tag "Binding DN" binddn) + string) + (list + :tag "Password" + :inline t + (const :tag "Password" passwd) + string) + (list + :tag "Authentication Method" + :inline t + (const :tag "Authentication Method" auth) + (choice + (const :menu-tag "None" :tag "None" nil) + (const :menu-tag "Simple" :tag "Simple" simple) + (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41) + (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42))) + (list + :tag "Search Base" + :inline t + (const :tag "Search Base" base) + string) + (list + :tag "Search Scope" + :inline t + (const :tag "Search Scope" scope) + (choice + (const :menu-tag "Default" :tag "Default" nil) + (const :menu-tag "Subtree" :tag "Subtree" subtree) + (const :menu-tag "Base" :tag "Base" base) + (const :menu-tag "One Level" :tag "One Level" onelevel))) + (list + :tag "Dereferencing" + :inline t + (const :tag "Dereferencing" deref) + (choice + (const :menu-tag "Default" :tag "Default" nil) + (const :menu-tag "Never" :tag "Never" never) + (const :menu-tag "Always" :tag "Always" always) + (const :menu-tag "When searching" :tag "When searching" search) + (const :menu-tag "When locating base" :tag "When locating base" find))) + (list + :tag "Time Limit" + :inline t + (const :tag "Time Limit" timelimit) + (integer :tag "(in seconds)")) + (list + :tag "Size Limit" + :inline t + (const :tag "Size Limit" sizelimit) + (integer :tag "(number of records)"))))) +:group 'ldap) (defun ldap-search (filter &optional host attributes attrsonly) "Perform an LDAP search. -FILTER is the search filter in RFC1558 syntax -HOST is the LDAP host on which to perform the search -ATTRIBUTES is a list of the specific attributes to retrieve, -nil means retrieve all -ATTRSONLY if non nil retrieves the attributes only without +FILTER is the search filter in RFC1558 syntax, i.e. something that +looks like \"(cn=John Smith)\". +HOST is the LDAP host on which to perform the search. +ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. +If ATTRSONLY is non nil, the attributes will be retrieved without the associated values. Additional search parameters can be specified through `ldap-host-parameters-alist' which see." (interactive "sFilter:") - (let (host-plist res ldap) - (if (null host) - (setq host ldap-default-host)) - (if (null host) - (error "No LDAP host specified")) - (setq host-plist - (cdr (assoc host ldap-host-parameters-alist))) + (or host + (setq host ldap-default-host)) + (or host + (error "No LDAP host specified")) + (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) + ldap) (message "Opening LDAP connection to %s..." host) (setq ldap (ldap-open host host-plist)) (message "Searching with LDAP on %s..." host) - (setq res (ldap-search-internal ldap filter - (plist-get host-plist 'base) - (plist-get host-plist 'scope) - attributes attrsonly)) - (ldap-close ldap) - res)) - + (prog1 (ldap-search-internal ldap filter + (plist-get host-plist 'base) + (plist-get host-plist 'scope) + attributes attrsonly) + (ldap-close ldap)))) - -(provide 'ldap) - ;;; ldap.el ends here diff --git a/lisp/package-admin.el b/lisp/package-admin.el index 730f5f3..dcc62a5 100644 --- a/lisp/package-admin.el +++ b/lisp/package-admin.el @@ -324,7 +324,7 @@ is the top-level directory under which the package was installed." start err-list ) (setq pkg-dir (package-admin-get-install-dir 'unknown pkg-dir)) - ;; Insure that the current directory doesn't change + ;; Ensure that the current directory doesn't change (save-excursion (set-buffer buf) ;; This is not really needed @@ -437,8 +437,7 @@ PACKAGE is a symbol, not a string." ;; Delete empty directories. (if dirs (let ( (orig-default-directory default-directory) -; directory files file - ) + directory files file ) ;; Make sure we preserve the existing `default-directory'. ;; JV, why does this change the default directory? Does it indeed? (unwind-protect diff --git a/lisp/package-get.el b/lisp/package-get.el index acc3483..646aae7 100644 --- a/lisp/package-get.el +++ b/lisp/package-get.el @@ -254,16 +254,16 @@ When nil, updates which are not PGP signed are allowed without confirmation." (defvar package-get-was-current nil "Non-nil we did our best to fetch a current database.") + +;Shouldn't this be in package-ui? ;;;###autoload (defun package-get-download-menu () "Build the `Add Download Site' menu." (mapcar (lambda (site) (vector (car site) - `(push (quote ,(cdr site)) - package-get-remote) - :style 'toggle - :selected `(member (quote ,(cdr site)) - package-get-remote))) + `(package-ui-add-site (quote ,(cdr site))) + :style 'toggle :selected + `(member (quote ,(cdr site)) package-get-remote))) package-get-download-sites)) ;;;###autoload @@ -612,6 +612,7 @@ required by PACKAGES." (mapcar #'(lambda (reqd) (let* ((reqd-package (package-get-package-provider reqd)) + (reqd-version (cadr reqd-package)) (reqd-name (car reqd-package))) (if (null reqd-name) (error "Unable to find a provider for %s" reqd)) diff --git a/lisp/package-ui.el b/lisp/package-ui.el index 3e49ae3..7eb73bd 100644 --- a/lisp/package-ui.el +++ b/lisp/package-ui.el @@ -62,6 +62,12 @@ Set this to `nil' to use the `default' face." :group 'pui :type 'face) +(defcustom pui-deleted-package-face 'blue + "*The face to use for packages marked for removal. +Set this to `nil' to use the `default' face." + :group 'pui + :type 'face) + (defcustom pui-outdated-package-face 'red "*The face to use for outdated packages. Set this to `nil' to use the `default' face." @@ -87,24 +93,31 @@ Set this to `nil' to use the `default' face." (defvar pui-selected-packages nil "The list of user-selected packages to install.") +(defvar pui-deleted-packages nil + "The list of user-selected packages to remove.") + +(defvar pui-actual-package "") + (defvar pui-display-keymap (let ((m (make-keymap))) (suppress-keymap m) (set-keymap-name m 'pui-display-keymap) (define-key m "q" 'pui-quit) (define-key m "g" 'pui-list-packages) - (define-key m " " 'pui-display-info) - (define-key m "?" 'pui-help) + (define-key m "i" 'pui-display-info) + (define-key m "?" 'describe-mode) (define-key m "v" 'pui-toggle-verbosity-redisplay) - (define-key m "d" 'pui-toggle-verbosity-redisplay) + (define-key m "d" 'pui-toggle-package-delete-key) + (define-key m "D" 'pui-toggle-package-delete-key) (define-key m [return] 'pui-toggle-package-key) (define-key m "x" 'pui-install-selected-packages) (define-key m "I" 'pui-install-selected-packages) (define-key m "r" 'pui-add-required-packages) (define-key m "n" 'next-line) - (define-key m "+" 'next-line) + (define-key m "+" 'pui-toggle-package-key) (define-key m "p" 'previous-line) - (define-key m "-" 'previous-line) + (define-key m " " 'scroll-up-command) + (define-key m [delete] 'scroll-down-command) m) "Keymap to use in the `pui-info-buffer' buffer") @@ -113,7 +126,7 @@ Set this to `nil' to use the `default' face." (set-keymap-name m 'pui-package-keymap) (define-key m 'button2 'pui-toggle-package-event) ;; We use a popup menu -;; (define-key m 'button3 'pui-toggle-package-event) + (define-key m 'button3 'pui-popup-context-sensitive) m) "Keymap to use over package names/descriptions.") @@ -160,6 +173,21 @@ Set this to `nil' to use the `default' face." )) ;;;###autoload +(defun package-ui-add-site (site) + "Add site to package-get-remote and possibly offer to update package list." + (let ((had-none (null package-get-remote))) + (push site package-get-remote) + (when (and had-none package-get-was-current + (y-or-n-p "Update Package list?")) + (setq package-get-was-current nil) + (package-get-require-base t) + (if (get-buffer pui-info-buffer) + (save-window-excursion + (pui-list-packages)))) + (set-menubar-dirty-flag))) + + +;;;###autoload (defun pui-add-install-directory (dir) "Add a new package binary directory to the head of `package-get-remote'. Note that no provision is made for saving any changes made by this function. @@ -198,18 +226,6 @@ disk." (interactive) (kill-buffer nil)) -(defun pui-help () - (interactive) - (let ( (help-buffer (get-buffer-create "*Help*")) ) - (display-buffer help-buffer t) - (save-window-excursion - (set-buffer help-buffer) - (buffer-disable-undo help-buffer) - (erase-buffer help-buffer) - (insert (pui-help-string)) - ) - )) - (defun pui-package-symbol-char (pkg-sym version) (progn (if (package-get-info-find-package packages-package-list pkg-sym) @@ -236,20 +252,22 @@ and whether or not it is up-to-date." (if (not version) (setq version (package-get-info-prop (extent-property extent 'pui-info) 'version))) - (if (member pkg-sym pui-selected-packages) - (progn - (if pui-selected-package-face - (set-extent-face extent (get-face pui-selected-package-face)) - (set-extent-face extent (get-face 'default))) - (setq sym-char "+") - ) - (progn - (setq disp (pui-package-symbol-char pkg-sym version)) - (setq sym-char (car disp)) - (if (car (cdr disp)) - (set-extent-face extent (get-face (car (cdr disp)))) - (set-extent-face extent (get-face 'default))) - )) + (cond ((member pkg-sym pui-selected-packages) + (if pui-selected-package-face + (set-extent-face extent (get-face pui-selected-package-face)) + (set-extent-face extent (get-face 'default))) + (setq sym-char "+")) + ((member pkg-sym pui-deleted-packages) + (if pui-deleted-package-face + (set-extent-face extent (get-face pui-deleted-package-face)) + (set-extent-face extent (get-face 'default))) + (setq sym-char "D")) + (t + (setq disp (pui-package-symbol-char pkg-sym version)) + (setq sym-char (car disp)) + (if (car (cdr disp)) + (set-extent-face extent (get-face (car (cdr disp)))) + (set-extent-face extent (get-face 'default))))) (save-excursion (goto-char (extent-start-position extent)) (delete-char 1) @@ -265,7 +283,9 @@ and whether or not it is up-to-date." (setq pui-selected-packages (delete pkg-sym pui-selected-packages)) (setq pui-selected-packages - (cons pkg-sym pui-selected-packages))) + (cons pkg-sym pui-selected-packages)) + (setq pui-deleted-packages + (delete pkg-sym pui-deleted-packages))) (pui-update-package-display extent pkg-sym) )) @@ -281,6 +301,37 @@ and whether or not it is up-to-date." (error "No package under cursor!")) )) +(defun pui-toggle-package-delete (extent) + (let (pkg-sym) + (setq pkg-sym (extent-property extent 'pui-package)) + (if (member pkg-sym pui-deleted-packages) + (setq pui-deleted-packages + (delete pkg-sym pui-deleted-packages)) + (setq pui-deleted-packages + (cons pkg-sym pui-deleted-packages)) + (setq pui-seleted-packages + (delete pkg-sym pui-selected-packages))) + (pui-update-package-display extent pkg-sym) + )) + + +(defun pui-toggle-package-delete-key () + "Select/unselect package for removal, using the keyboard." + (interactive) + (let (extent) + (if (setq extent (extent-at (point) (current-buffer) 'pui)) + (progn + (pui-toggle-package-delete extent) + (forward-line 1) + ) + (error "No package under cursor!")) + )) + +(defun pui-current-package () + (let ((extent (extent-at (point) (current-buffer) 'pui))) + (if extent + (extent-property extent 'pui-package)))) + (defun pui-toggle-package-event (event) "Select/unselect package for installation, using the mouse." (interactive "e") @@ -302,6 +353,37 @@ and whether or not it is up-to-date." (defun pui-install-selected-packages () "Install selected packages." (interactive) + (let ( (tmpbuf "*Packages-To-Remove*") do-delete) + (when pui-deleted-packages + (save-window-excursion + (with-output-to-temp-buffer tmpbuf + (display-completion-list (sort + (mapcar '(lambda (pkg) + (symbol-name pkg) + ) + pui-deleted-packages) + 'string<) + :activate-callback nil + :help-string "Packages selected for removal:\n" + :completion-string t + )) + (setq tmpbuf (get-buffer-create tmpbuf)) + (display-buffer tmpbuf) + (setq do-delete (yes-or-no-p "Remove these packages? ")) + (kill-buffer tmpbuf)) + (when do-delete + (message "Deleting selected packages ...") (sit-for 0) + (when (catch 'done + (mapcar (lambda (pkg) + (if (not + (package-admin-delete-binary-package + pkg (package-admin-get-install-dir pkg nil))) + (throw 'done nil))) + pui-deleted-packages) + t) + (message "Packages deleted") + )))) + (let ( (tmpbuf "*Packages-To-Install*") do-install) (if pui-selected-packages (progn @@ -351,7 +433,9 @@ and whether or not it is up-to-date." (clear-message) ) ) - (error "No packages have been selected!")) + (if pui-deleted-packages + (pui-list-packages) + (error "No packages have been selected!"))) )) (defun pui-add-required-packages () @@ -434,59 +518,70 @@ attached to the extent as properties)." )) )) -(defun pui-display-info (&optional no-error) +(defun pui-display-info (&optional no-error event) "Display additional package info in the modeline. Designed to be called interactively (from a keypress)." (interactive) (let (extent) (save-excursion (beginning-of-line) - (if (setq extent (extent-at (point) (current-buffer) 'pui)) + (if (setq extent (extent-at (point) (current-buffer) 'pui)) (message (pui-help-echo extent t)) (if no-error (clear-message nil) (error "No package under cursor!"))) ))) -(defun pui-help-string () - "Return the help string for the package-info buffer. -This is not a defconst because of the call to substitute-command-keys." +;;; "Why is there no standard function to do this?" +(defun pui-popup-context-sensitive (event) + (interactive "e") (save-excursion - (set-buffer (get-buffer pui-info-buffer)) - (substitute-command-keys -"Symbols in the leftmost column: + (set-buffer (event-buffer event)) + (goto-char (event-point event)) + (popup-menu pui-menu event) + ;; I agreee with dired.el this is seriously bogus. + (while (popup-menu-up-p) + (dispatch-event (next-event))))) + +(defvar pui-menu + '("Packages" + ["Toggle install " pui-toggle-package-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] + ["Toggle delete " pui-toggle-package-delete-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] + ["Info on" pui-display-info :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] + "---" + ["Add Required" pui-add-required-packages t] + ["Install/Remove Selected" pui-install-selected-packages t] + "---" + ["Verbose" pui-toggle-verbosity-redisplay + :active t :style toggle :selected pui-list-verbose] + ["Refresh" pui-list-packages t] + ["Help" pui-help t] + ["Quit" pui-quit t])) + + +(defun list-packages-mode () + "Symbols in the leftmost column: + The package is marked for installation. - The package has not been installed. + D The package has been marked for deletion. * The currently installed package is old, and a newer version is available. Useful keys: `\\[pui-toggle-package-key]' to select/unselect the current package for installation. + `\\[pui-toggle-package-delete-key]' to select/unselect the current package for removal. `\\[pui-add-required-packages]' to add any packages required by those selected. - `\\[pui-install-selected-packages]' to install selected packages. + `\\[pui-install-selected-packages]' to install/delete selected packages. `\\[pui-display-info]' to display additional information about the package in the modeline. `\\[pui-list-packages]' to refresh the package list. `\\[pui-toggle-verbosity-redisplay]' to toggle between a verbose and non-verbose display. `\\[pui-quit]' to kill this buffer. -") - )) - -(defvar pui-menu - '("Packages" - ["Select" pui-toggle-package-key t] - ["Info" pui-display-info t] - "---" - ["Add Required" pui-add-required-packages t] - ["Install Selected" pui-install-selected-packages t] - "---" - ["Verbose" pui-toggle-verbosity-redisplay - :active t :style toggle :selected pui-list-verbose] - ["Refresh" pui-list-packages t] - ["Help" pui-help t] - ["Quit" pui-quit t])) +" + (error "You cannot enter this mode directly. Use `pui-list-packages'")) +(put 'list-packages-mode 'mode-class 'special) ;;;###autoload (defun pui-list-packages () @@ -505,7 +600,19 @@ select packages for installation via the keyboard or mouse." (setq buffer-read-only nil) (buffer-disable-undo outbuf) (erase-buffer outbuf) + (kill-all-local-variables) (use-local-map pui-display-keymap) + (setq major-mode 'list-packages-mode) + (setq mode-name "Packages") + (setq truncate-lines t) + + (unless package-get-remote + (insert " +Warning: No download sites specified. Package index may be out of date. + If you intend to install packages, specify download sites first. + +")) + (if pui-list-verbose (insert " Latest Installed Package name Vers. Vers. Description @@ -577,13 +684,14 @@ select packages for installation via the keyboard or mouse." (symbol-name (car b))) ))) (insert sep-string) - (insert (pui-help-string)) + (insert (documentation 'list-packages-mode)) (set-buffer-modified-p nil) (setq buffer-read-only t) (pop-to-buffer outbuf) (delete-other-windows) (goto-char start) (setq pui-selected-packages nil) ; Reset list + (setq pui-deleted-packages nil) ; Reset list (when (featurep 'menubar) (set-buffer-menubar current-menubar) (add-submenu '() pui-menu) @@ -592,6 +700,8 @@ select packages for installation via the keyboard or mouse." ; (message (substitute-command-keys "Press `\\[pui-help]' for help.")) )) +;;;###autoload +(defalias 'list-packages 'pui-list-packages) (provide 'package-ui) diff --git a/lisp/sound.el b/lisp/sound.el index be24062..af52042 100644 --- a/lisp/sound.el +++ b/lisp/sound.el @@ -82,7 +82,7 @@ (const :format "" :value :duration) (integer :tag "Duration")))))) -(defcustom sound-load-alist +(defcustom sound-load-list '((load-sound-file "drum-beep" 'drum) (load-sound-file "quiet-beep" 'quiet) (load-sound-file "bass-snap" 'bass 80) @@ -105,9 +105,9 @@ :type 'directory ) -(defcustom sound-ext (if (or (eq system-type 'cygwin32) - (eq system-type 'windows-nt)) - ".wav:" ".au:") +(defcustom sound-extension-list (if (or (eq system-type 'cygwin32) + (eq system-type 'windows-nt)) + ".wav:" ".au:") "Filename extensions to complete sound file name with. If more than one extension is used, they should be separated by \":\". " :group 'sound @@ -144,7 +144,7 @@ nVolume (0 for default): ") (error "volume not an integer or nil")) (let (buf data - (file (locate-file filename default-sound-directory-list sound-ext))) + (file (locate-file filename default-sound-directory-list sound-extension-list))) (unless file (error "Couldn't load sound file %s" filename)) (unwind-protect @@ -180,7 +180,7 @@ server and XEmacs has the necessary sound support compiled in." (message "Loading sounds...") (setq sound-alist nil) ;; this is where the calls to load-sound-file get done - (mapc 'eval sound-load-alist) + (mapc 'eval sound-load-list) (setq sound-alist (append sound-default-alist sound-alist)) diff --git a/man/ChangeLog b/man/ChangeLog index 6646356..790c7a7 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,7 @@ +1998-12-24 Martin Buchholz + + * XEmacs 21.2.7 is released. + 1998-12-16 Andy Piper * XEmacs 21.2.6 is released diff --git a/man/xemacs/packages.texi b/man/xemacs/packages.texi index 4fb953e..91ac7fb 100644 --- a/man/xemacs/packages.texi +++ b/man/xemacs/packages.texi @@ -35,13 +35,13 @@ may not in general safely remove any of them. @cindex single-file packages A single-file package is an aggregate collection of thematically related but otherwise independent lisp files. These files are bundled -together for download convenience and individual files may deleted at +together for download convenience and individual files may be deleted at will without any loss of functionality. @end itemize @subsection Package Distributions -XEmacs Lisp packages are distributed in two ways depending on the +XEmacs Lisp packages are distributed in two ways, depending on the intended use. Binary Packages are for installers and end-users and may be installed directly into an XEmacs package directory. Source Packages are for developers and include all files necessary for rebuilding @@ -56,7 +56,7 @@ hierarchy. @cindex source packages Source packages contain all of the Package author's (where appropriate in regular packages) source code plus all of the files necessary to -build distribution tarballs (Unix Tar format files and gzipped for space +build distribution tarballs (Unix Tar format files, gzipped for space savings). @node Using Packages, Building Packages, Package Terminology, Packages @@ -78,7 +78,7 @@ non-essential packages were made optional. @subsection Choosing the Packages You Need The available packages can currently be found in the same ftp directory -where you grabbed the core distribition from, and are located in the +where you grabbed the core distribution from, and are located in the subdirectory @file{packages/binary-packages}. Package file names follow the naming convention @file{--pkg.tar.gz}. @@ -259,7 +259,7 @@ it depends upon. Pre-compiled, binary packages can be installed in either a system package directory (this is determined when XEmacs is compiled), or in a -subdirectory off your @file{$HOME} directory: +subdirectory of your @file{$HOME} directory: @example ~/.xemacs/packages diff --git a/nt/ChangeLog b/nt/ChangeLog index 34858e3..dea20d2 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,26 @@ +1998-12-24 Martin Buchholz + + * XEmacs 21.2.7 is released. + +1998-12-13 Jonathan Harris + + * xemacs.mak: + Replaced PACKAGEPATH variable with PACKAGE_PREFIX. + configure-package-path is initialised to contain + subdirectories of PACKAGE_PREFIX. The install target makes + a skeleton package tree under PACKAGE_PREFIX. + + * README, PROBLEMS: + Documented the package path changes. + Corrected the advice on a suitable minimal set of packages. + +1998-12-17 Andy Piper + + * xemacs.mak ($(LIB_SRC)/movemail.exe): adapt make rule to build + with pop support. + + * xemacs.mak: add gui-msw.c and glyphs-widget.c object lists. + 1998-12-16 Andy Piper * XEmacs 21.2.6 is released diff --git a/nt/PROBLEMS b/nt/PROBLEMS index b1442a4..0be8bff 100644 --- a/nt/PROBLEMS +++ b/nt/PROBLEMS @@ -47,9 +47,9 @@ that your "home" directory is, in order of preference: ** XEmacs can't find any packages -The directory tree under which XEmacs looks for your packages is set -at compile-time, and defaults to C:\Program Files\XEmacs\Packages. The -variable configure-package-path holds the actual value that was +XEmacs looks for your packages in subdirectories of a directory which +is set at compile-time, and defaults to C:\Program Files\XEmacs. The +variable configure-package-path holds the actual path that was compiled into your copy of XEmacs. The compile-time default location can be overridden by the diff --git a/nt/README b/nt/README index 6906c1a..42c2293 100644 --- a/nt/README +++ b/nt/README @@ -23,8 +23,9 @@ To get it working you will need: 2. Grab the latest XEmacs source from ftp.xemacs.org if necessary. All Win32 support is in the nt\ subdirectory. You'll also need the xemacs-base package from the binary-packages subdirectory and you'll probably also - want at least the edit-utils, text-utils, cc-mode and prog-utils packages. - Unpack the packages into, say, "c:\Program Files\XEmacs\packages". + want at least the edit-utils, text-modes, fsf-compat, cc-mode, + prog-modes and xemacs-devel packages. + Unpack the packages into, say, "c:\Program Files\XEmacs\xemacs-packages". 3. At this point you can select X or Win32 native GUI support. @@ -71,23 +72,24 @@ If you want to build for native GUI: If you want to build with GIF support, add this to the nmake command line: HAVE_GIF=1 -7. By default, XEmacs will look for packages in - "c:\Program Files\XEmacs\packages". If you want it to look elsewhere, - add this to the nmake command line: - PACKAGEPATH="x:\\location\\of\\your\\packages" - Note the doubled-up backslashes in that path. If you want to change the - package path after you've already built XEmacs, delete the file - .\obj\emacs.obj before rebuilding with the new value of PACKAGEPATH. +7. By default, XEmacs will expect to find its packages in the subdirectories + "site-packages", "mule-packages" and "xemacs-packages" under the package + prefix directory "c:\Program Files\XEmacs". If you want it to look for + these subdirectories elsewhere, add this to the nmake command line: + PACKAGE_PREFIX="x:\your\package\directory" + If you change your mind and want to alter the package prefix directory + after you've built XEmacs, delete the file .\obj\emacs.obj and rebuild with + the new PACKAGE_PREFIX. 8. By default, XEmacs will be installed in directories under the directory - "c:\Program Files\XEmacs\XEmacs-21.0". If you want to install it - elsewhere, add this to the nmake command line: + "c:\Program Files\XEmacs\XEmacs-21.0". If you want to install it elsewhere, + add this to the nmake command line: INSTALL_DIR="x:\your\installation\directory" 9. Now you can press Enter. nmake will build temacs, the DOC file, update the elc's, dump xemacs and install the relevant files in the directories under the installation directory. Unless you set INSTALL_DIR above, the file that - you should run to start XEmacs will be installed as + you should run to start XEmacs will be installed as "c:\Program Files\XEmacs\XEmacs-21.0\i386-pc-win32\runemacs.exe". You may want to create a shortcut to that file from your Desktop or Start Menu. diff --git a/nt/config.h b/nt/config.h index a10ff2e..e012c18 100644 --- a/nt/config.h +++ b/nt/config.h @@ -605,7 +605,7 @@ on various systems. */ /* movemail options */ /* Should movemail use POP3 for mail access? */ -#undef MAIL_USE_POP +/* #undef MAIL_USE_POP */ /* Should movemail use kerberos for POP authentication? */ #undef KERBEROS /* Should movemail use hesiod for getting POP server host? */ diff --git a/nt/xemacs.mak b/nt/xemacs.mak index c3ff3bb..de64bc6 100644 --- a/nt/xemacs.mak +++ b/nt/xemacs.mak @@ -65,11 +65,13 @@ INSTALL_DIR=c:\Program Files\Infodock\Infodock-$(INFODOCK_VERSION_STRING) INSTALL_DIR=c:\Program Files\XEmacs\XEmacs-$(XEMACS_VERSION_STRING) ! endif !endif -!if !defined(PACKAGEPATH) -PATH_PACKAGEPATH="c:\\Program Files\\XEmacs\\packages" -!else -PATH_PACKAGEPATH="$(PACKAGEPATH)" +!if !defined(PACKAGE_PATH) +! if !defined(PACKAGE_PREFIX) +PACKAGE_PREFIX=c:\Program Files\XEmacs +! endif +PACKAGE_PATH=~\.xemacs;;$(PACKAGE_PREFIX)\site-packages;$(PACKAGE_PREFIX)\mule-packages;$(PACKAGE_PREFIX)\xemacs-packages !endif +PATH_PACKAGEPATH="$(PACKAGE_PATH:\=\\)" !if !defined(HAVE_MSW) HAVE_MSW=1 !endif @@ -222,7 +224,7 @@ USE_INDEXED_LRECORD_IMPLEMENTATION=$(GUNG_HO) !message XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename) configured for "$(EMACS_CONFIGURATION)". !message !message Installation directory is "$(INSTALL_DIR)". -!message Package path is $(PATH_PACKAGEPATH). +!message Package path is "$(PACKAGE_PATH)". !message !if $(INFODOCK) !message Building InfoDock. @@ -504,6 +506,9 @@ CONFIG_VALUES = $(LIB_SRC)\config.values ETAGS_DEPS = $(LIB_SRC)/getopt.c $(LIB_SRC)/getopt1.c $(LIB_SRC)/../src/regex.c $(LIB_SRC)/etags.exe : $(LIB_SRC)/etags.c $(ETAGS_DEPS) $(LIB_SRC)/movemail.exe: $(LIB_SRC)/movemail.c $(LIB_SRC)/pop.c $(ETAGS_DEPS) + @cd $(LIB_SRC) + $(CCV) -I. -I$(XEMACS)/src -I$(XEMACS)/nt/inc $(LIB_SRC_DEFINES) -O2 -W3 -Fe$@ $** wsock32.lib + @cd $(NT) LIB_SRC_TOOLS = \ $(LIB_SRC)/make-docfile.exe \ @@ -1006,9 +1011,10 @@ temacs: $(TEMACS) # use this rule to install the system install: all @echo Installing in $(INSTALL_DIR) ... + @echo PlaceHolder > PlaceHolder @xcopy /q PROBLEMS "$(INSTALL_DIR)\" - @xcopy /q README "$(INSTALL_DIR)\lock\" - @del "$(INSTALL_DIR)\lock\README" + @xcopy /q PlaceHolder "$(INSTALL_DIR)\lock\" + @del "$(INSTALL_DIR)\lock\PlaceHolder" @xcopy /q $(LIB_SRC)\*.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)\" @copy $(LIB_SRC)\DOC "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" @copy $(CONFIG_VALUES) "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" @@ -1017,6 +1023,14 @@ install: all @xcopy /e /q $(XEMACS)\etc "$(INSTALL_DIR)\etc\" @xcopy /e /q $(XEMACS)\info "$(INSTALL_DIR)\info\" @xcopy /e /q $(XEMACS)\lisp "$(INSTALL_DIR)\lisp\" + @echo Making skeleton package tree in $(PACKAGE_PREFIX) ... + @xcopy /q PlaceHolder "$(PACKAGE_PREFIX)\site-packages\" + @del "$(PACKAGE_PREFIX)\site-packages\PlaceHolder" + @xcopy /q PlaceHolder "$(PACKAGE_PREFIX)\mule-packages\" + @del "$(PACKAGE_PREFIX)\mule-packages\PlaceHolder" + @xcopy /q PlaceHolder "$(PACKAGE_PREFIX)\xemacs-packages\" + @del "$(PACKAGE_PREFIX)\xemacs-packages\PlaceHolder" + @del PlaceHolder distclean: del *.bak diff --git a/src/ChangeLog b/src/ChangeLog index 3335350..b3395f9 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,653 @@ +1998-12-24 Martin Buchholz + + * XEmacs 21.2.7 is released. + +1998-12-23 Martin Buchholz + + * glyphs.c (decode_device_ii_format): + - Fix indentation. + - Use GET_C_STRING_FILENAME_DATA_ALLOCA with char *, not Extbyte *. + + * glyphs-x.c (x_subwindow_instantiate): + - A image instance mask was being assigned to a image instance type! + - X_SUBWINDOW_INSTANCE_DATA (ii) is not an lvalue in C++. + + * glyphs-msw.c (mswindows_initialize_dibitmap_image_instance): + Fix indentation. + * glyphs-x.h: Make indentation consistent. + + * emacs.c (Fdump_emacs): Remove Steve Martin merge artifacts. + + * glyphs-widget.c (check_valid_glyph): Warning suppression. + - Make it static + - #ifdef it out, since it's not actually used yet (FIX THIS!) + + * glyphs-widget.c: + * glyphs.h: + Move declarations of decode_device_ii_format and + decode_image_instantiator_format into glyphs.h where they belong. + +1998-12-22 Martin Buchholz + + * frame-x.c (x_delete_frame): Revert part of my changes at the + suggestion of Gunnar Evermann - unfortunately no one really + understands this code. + + * callproc.c (init_callproc): code cleanup. + + * free-hook.c (malloc): + (check_malloc): + (__free_hook): + (__malloc_hook): + (__realloc_hook): + (block_input_malloc): + (block_input_realloc): + * device-x.c (x_delete_device): + * emacs.c (voodoo_free_hook): + * events.c (print_event): + (CHECK_EVENT_TYPE): + (CHECK_EVENT_TYPE2): + (CHECK_EVENT_TYPE3): + Use proper prototypes. + Make C_E_T macros a little faster. + Pedantic fiddly little changes. You really don't care. + +1998-12-22 Andy Piper + + * redisplay-output.c (redisplay_clear_region): make sure that + fg/bg colors get set even when we are in the border area. + +1998-12-13 Martin Buchholz + + * console-msw.c: Function definitions follow coding standards + - This prevents e.g. find-tag on Lisp_Event finding DEVENT + +1998-12-11 Martin Buchholz + + * events.h (struct timeout_data): + * event-tty.c (tty_timeout_to_emacs_event): + * event-msw.c (mswindows_wm_timer_callback): + * event-Xt.c (Xt_timeout_to_emacs_event): + * event-msw.c (mswindows_cancel_dispatch_event): + Make sure Lisp_Objects inside events are initialized to Qnil, not + Qnull_pointer, which is now illegal. + +1998-12-10 Martin Buchholz + + * lisp.h: Fix up prototypes to match alloc.c + +1998-12-08 Martin Buchholz + + * windowsnt.h: Remove `support' for using index and rindex + + * filelock.c (current_lock_owner): + - Change uses of index -> strchr, rindex -> strrchr + +1998-12-07 Martin Buchholz + + * sysdep.c (set_descriptor_non_blocking): + Since O_NONBLOCK is now always #defined, make use of fcntl + conditional on F_SETFL being defined. + + * console-msw.c (DHEADgER): + (DOPAQUE_DATA): + (DEVENT): + (DCONS): + (DCONSCDR): + (DSTRING): + (DVECTOR): + (DSYMBOL): + (DSYMNAME): + - max_align_t should not be visible to the user of the + XOPAQUE_DATA macro. + - use Bufbyte instead of char + - parens around (FOOP (obj)) are always redundant. + If they were necessary, we should fix the macro instead. + - Always use string_data(foo) instead of foo->data. + + +1998-12-06 Martin Buchholz + + * frame-msw.c (mswindows_init_frame_1): + - use make_lisp_hash_table, not Fmake_hash_table + - include elhash.h + + * lisp.h: + * alloc.c (make_vector): remove travesty + (Fmake_vector): + (make_pure_vector): + (pure_cons): + (make_bit_vector_internal): + (make_bit_vector): + (make_bit_vector_from_byte_vector): + (Fmake_bit_vector): + - make vector_equal a little faster. + - Don't use variable name `new'. + - Use size_t instead of EMACS_INT. + - usual Martin-style pointless bit-twiddling. + + * fns.c (mapcar1): + (Fmapconcat): + (Fmapcar): + (Fmapvector): + Make mapcar faster. In particular, make + (mapc #'identity long-string) + MUCH faster under Mule. + * tests/automated/lisp-tests.el: Test 'em! + + * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded + bytecode. + +1998-12-01 Martin Buchholz + + * menubar-x.c (menu_item_descriptor_to_widget_value_1): Always use + Qnil, not NULL, to initialize `null' Lisp_Objects. + +1998-11-29 Hrvoje Niksic + + * specifier.c (display_table_validate): Update. + + * redisplay.c (create_text_block): Use them. + + * glyphs.c (display_table_entry): New function. + (get_display_tables): Ditto. + +1998-12-15 Oscar Figueiredo + + * eldap.c (toplevel): Mention that eldap.c compiles with + OpenLDAP libs + (Fldap_open): Use `GET_C_STRING_OS_DATA_ALLOCA' + (Fldap_search_internal): Ditto + +1998-12-11 Martin Buchholz + + * event-msw.c (mswindows_cancel_dispatch_event): + Gratuitous code prettification + + +1998-12-07 Hrvoje Niksic + + * fns.c (Fnconc): Fix use of wrong_type_argument(). + + * floatfns.c (Ffloat): Fix docstring. + (Ffloat): Fix use of wrong_type_argument(). + (Fabs): Ditto. + (extract_float): Ditto. + (Fceiling): Ditto. + (Fround): Ditto. + (Ftruncate): Ditto. + +1998-12-06 Martin Buchholz + + * frame-msw.c (mswindows_init_frame_1): + - use make_lisp_hash_table, not Fmake_hash_table + - include elhash.h + + * lisp.h: + * alloc.c (make_vector): remove travesty + (Fmake_vector): + (make_pure_vector): + (pure_cons): + (make_bit_vector_internal): + (make_bit_vector): + (make_bit_vector_from_byte_vector): + (Fmake_bit_vector): + - make vector_equal a little faster. + - Don't use variable name `new'. + - Use size_t instead of EMACS_INT. + - usual Martin-style pointless bit-twiddling. + + * fns.c (mapcar1): + (Fmapconcat): + (Fmapcar): + (Fmapvector): + Make mapcar faster. In particular, make + (mapc #'identity long-string) + MUCH faster under Mule. + * tests/automated/lisp-tests.el: Test 'em! + + * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded + bytecode. + +1998-12-02 Didier Verna + + * menubar-x.c (menu_item_descriptor_to_widget_value_1): set the + accelerator field to nil for labels. + +1998-12-16 Jonathan Harris + + * menubar-msw.c (displayable_menu_item): + Escape occurrences of '&' and support occurrences of the + '%_' accelerator indicator in menus. + +1998-11-26 Didier Verna + + * dired.c (Fdirectory_files): use make_string instead of + make_ext_string on the filename. The conversion external->internal + format is already done in sys_readdir. + +1998-12-15 Gunnar Evermann + + * glyphs.c (normalize_image_instantiator): GCPRO instantiator + +1998-12-16 Jonathan Harris + + * event-msw.c + (Belatedly) added Kirill to list of file's authors. + emacs_mswindows_quit_p: Don't process WM_PAINT messages in + quit checking. WM_PAINT messages cause redisplay, but + windows' states are not necessarily stable when this function + gets called. + +1998-12-17 Andy Piper + + * strftime.c (zone_name): CONSTify. + +1998-12-15 Andy Piper + + * glyphs-msw.c (mswindows_combo_instantiate): ditto. + (mswindows_widget_property): return Qunbound when no property available. + (mswindows_button_property): ditto. + (mswindows_combo_property): ditto. + (mswindows_widget_set_property): ditto. + + * glyphs-widget.c (check_valid_item_list): use properties. + + * glyphs.h (struct Lisp_Image_Instance): we have properties now. + + * glyphs.c (Fset_image_instance_property): allow setting of arbitrary properties. + (Fimage_instance_property): ditto. + * glyphs-widget.c (widget_property): ditto. + (widget_set_property): ditto. + + * frame-msw.c (mswindows_set_frame_pointer): SetCursor() as well + as setting the class cursor so that GC actually changes the + cursor. + + * config.h: don't undef MAIL_USE_POP. + +1998-12-13 Andy Piper + + * glyphs-msw.c + (image_instantiator_format_create_glyphs_mswindows): line -> + label. + (mswindows_label_instantiate): ditto. Play with window flags. + (image_instantiator_format_create_glyphs_mswindows): ditto. + (vars_of_glyphs_mswindows): provide Qlabel as we support it now. + + * glyphs-widget.c (widget_instantiate_1): re-jig autosizing to + cope with lines and labels. + (static_instantiate): use widget_instantiate_1. + line -> label. + (image_instantiator_format_create_glyphs_widget): ditto. + +1998-12-10 Andy Piper + + * Makefile.in.in (objs): add gui.o + +1998-12-10 Andy Piper + + * gui.c: adjust defines of HAVE_POPUPS so that we can build with + no window system. + +1998-12-09 Andy Piper + + * glyphs.c (finalize_image_instance): mark glyphs changed when an + image instance is removed so that the subwindow cache gets reset + and thus destroyed images get GC'd. + +1998-12-08 Andy Piper + + * gui-msw.c (mswindows_handle_gui_wm_command): call + MARK_SUBWINDOWS_CHANGED. + + * glyphs-msw.c (mswindows_finalize_image_instance): make sure + subwindows really get deleted. + + * redisplay.c: new variable subwindows_changed[_set]. + (redisplay_window): use it. + (redisplay_frame): ditto. + (redisplay_device): ditto. + (redisplay_without_hooks): ditto. + + * device.h (MARK_DEVICE_SUBWINDOWS_CHANGED): new macro for + subwindows redisplay as per glyphs equivalent. + * redisplay.h: ditto. + (MARK_SUBWINDOWS_CHANGED): ditto. + (RESET_CHANGED_SET_FLAGS): ditto. + * frame.h (MARK_FRAME_SUBWINDOWS_CHANGED): ditto. + +1998-12-07 Andy Piper + + * frame.c (Fmake_frame): reset subwindow cachels on non-stream + frames. + + * redisplay.c (redisplay_frame): invalidate subwindow cachels. + + * event-msw.c (mswindows_wnd_proc): catch the various WM_CTLCOLOR* + messages and paint widget glyphs as appropriate with their face fg + & bg. + +1998-12-06 Andy Piper + + * glyphs-msw.c (vars_of_glyphs_mswindows): provide widget types + here rather than in glyphs-widget - do this because we only want + to provide what is really available. + + * glyphs.c (Fimage_instance_property): new function to get the + properties of image instances. wires through to console specific + methods and then to widget specific methods. + (Fset_image_instance_property): ditto but for setting widget properties. + (check_valid_face): make extern so that it can be used elsewhere. + + * glyphs-widget.c (widget_property): new function. gets the + properties of widgets in general and wires the function through to + widget specific ones. + (widget_set_property): ditto but for setting widget properties. + + * glyphs-msw.c (mswindows_combo_instantiate): Add functionality to + add items to the list. Play with window styles a bit to get the + desired effect. + (mswindows_widget_property): break out specific widget properties. + (mswindows_button_property): new function. gets the checked state + of a button. + (mswindows_combo_property): new function. gets the current + selection in the combo box. + (mswindows_widget_set_property): new function. sets specific + properties of specific widgets. + + * glyphs-widget.c (check_valid_item_list): new function. check + that items for a combo-box are just a list of strings. + (combo_validate): new function. check there is an item list. + (widget_instantiate_1): new function. renamed from + widget_instantiate so that we can do slightly different things for + other widgets. + (widget_instantiate): call widget_instantiate_1. + (combo_instantiate): new function to instantiate combo boxes, + defaults height to the pixel height of the number of items in the + box. + (syms_of_glyphs_widget): move widget keywords here. + (image_instantiator_format_create_glyphs_widget): use new combo + functions. + +1998-12-04 Andy Piper + + * event-msw.c (mswindows_wnd_proc): mule-ize. + + * glyphs.c (pixmap_to_lisp_data): mule-ize. + + * glyphs-msw.c (extract_xpm_color_names): mule-ize. + (resource_name_to_resource): ditto. + (mswindows_resource_instantiate): ditto. + (mswindows_widget_instantiate): ditto. + (mswindows_widget_set_property): ditto. + + * redisplay-output.c (redisplay_output_subwindow): don't show + subwindows if they are obscured at the edge of the frame, emacs + gets into some sort of redisplay loop otherwise. + + * gui.h: prototype gui_item_selected_p. + + * gui.c (gui_item_selected_p): new function to determine the + selected state of a gui_item. + + * frame.h (struct frame): add subwindows_changed flag. + + * redisplay.c (redisplay_frame): call update_frame_subwindows (). + + * glyphs.c (update_subwindow): new function to update a + subwindow's state. + (update_frame_subwindows): new function to update all the + subwindows on a frame. + + * console.h (struct console_methods): add update_subwindow. + + * glyphs-msw.c (mswindows_widget_property): return selected state + for selected property. + (mswindows_update_subwindow): new function. updates widget glyphs + in redisplay as per menubars or toolbars e.g. selected state. + (console_type_create_glyphs_mswindows): add update_subwindow. + +1998-12-03 Andy Piper + + * console-tty.c (syms_of_console_tty): MULE -> FILE_CODING since + tty coding system things are such. + + * glyphs-widget.c (widget_face_font_info): new function for + pulling out height and width metrics for a widget's face. + (widget_text_to_pixel_conversion): calculate pixel sizes of text + for widgets. + + * event-msw.c (mswindows_drain_windows_queue): translate messages + that are destined for subwindows. This makes edit fields interact + with the keyboard correctly. + nuke warnings by #ifndef'ing out stuff not required by msg select(). + + * glyphs.h (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM): new + macro defining the iiforma without the symbol required by widget. + (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT): use it. + + * general.c (syms_of_general): add Qwidget, Qselected. + + * faces.c (complex_vars_of_faces): add widget face inheriting from + gui-element face. + +1998-11-09 Andy Piper + + * window.h (struct window): add a cache of subwindows on a + per-window basis. + + * window.c (mark_window): mark the subwindow_instance_cache. + (allocate_window): initialise the subwindow instance_cache. + + * toolbar-x.c (x_output_toolbar): call redisplay_clear_region + instead of the devmeth. + (x_clear_toolbar): ditto. + + * redisplay-x.c (x_output_display_block): call + redisplay_output_subwindow for subwindows and widgets. + + * redisplay-tty.c (tty_output_display_block): add IMAGE_WIDGET to + types to do nothing for. + + * lisp.h: declare new widget/subwindow symbols. + + * glyphs.c (image_instantiate): cache subwindows on a per-window + basis. + (subwindow_possible_dest_types): new function for subwindow dest + types. + (subwindow_instantiate): generic instantiation of a + subwindow. specialised by device multi-methods. + (Fsubwindowp): moved from glyphs-x.c. adapted for glyph-based + subwindows. + (Fimage_instance_subwindow_id): ditto. + (Fresize_subwindow): ditto. + (Fforce_subwindow_map): ditto. + + * glyphs-x.c (x_print_image_instance): remove subwindow + stuff. Handled genrically in glyphs.c. + (x_image_instance_equal): ditto. + (x_image_instance_hash): ditto. + (x_finalize_image_instance): delete subwindows when required. + (mark_subwindow) (print_subwindow) (finalize_subwindow) + (subwindow_hash) (Fmake_subwindow): deleted because of new, + glyph-based, subwindow implementation. + (Fsubwindow_height) (Fsubwindow_width) (Fsubwindow_xid): aliased + in glyphs.el + (Fsubwindowp) (Fresize_subwindow) (Fforce_subwindow_map): moved to + glyphs.c. + (x_unmap_subwindow): new function to unmap X subwindows. + (x_map_subwindow): new function to map X subwindows. + (x_subwindow_instantiate): new function to instantiate X + subwindows. + (x_resize_subwindow): new function to resize X subwindows. + (console_type_create_glyphs_x): add subwindow functions. + (image_instantiator_format_create_glyphs_x): add device + multi-methods for xpm, xbm and subwindow. + + * glyphs.el (subwindow-xid): old alias for new subwindow functions. + (subwindow-width): ditto. + (subwindow-height): ditto. + + * glyphs-msw.c (mswindows_widget_instantiate): new function for + generally instantiating ms subwindows. Used by + mswindows_*_instantiate. + (mswindows_edit_instantiate): instantiate an edit field on a + mswindows frame. + +1998-11-04 Andy Piper + + * symsinit.h: declare new functions. + + * redisplay.h: declare new functions. + + * redisplay-x.c (x_output_display_block): call + redisplay_clear_region rather than x_clear_region. + (x_output_string): ditto. + (x_output_pixmap): ditto. + (x_clear_to_window_end): ditto. + (x_output_eol_cursor): ditto. + (x_clear_region): only do X specific things. other duties handled + in redisplay_clear_region. + + * redisplay-tty.c (tty_clear_region): do tty specific things - some + duties moved to redisplay_clear_region. + + * redisplay-output.c (clear_left_border): use + redisplay_clear_region instead of device method. + (clear_right_border): ditto. + (output_display_line): ditto. + (redisplay_output_subwindow): ditto. + (redisplay_clear_top_of_window): ditto. + (redisplay_clear_region): perform duties previously handled by + device methods. call the appropriate device method at the + end. unmap subwindows if necessary. + + * redisplay-msw.c (mswindows_output_string): use + redisplay_clear_region instead of mswindows_clear_region. + (mswindows_clear_to_window_end): ditto. + (mswindows_output_display_block): output subwindows when required. + (mswindows_clear_region): only do mswindows specific things, + everything else is now handled in redisplay_clear_region. + + * gui.h: add item id hash defines and declare function prototypes. + + * gui.c (mark_gui_item): new function for marking gui_items. + (gui_item_hash): generic hash function for generating command ids + for gui_items. + + * gui-msw.c: new file. + (mswindows_handle_gui_wm_command): new function to handle widget + callbacks. + + * glyphs.h (MAYBE_IIFORMAT_DEVMETH): new function for device + multi-methods. + (IIFORMAT_HAS_SHARED_METHOD): ditto. + (DEFINE_DEVICE_IIFORMAT): ditto. + (INITIALIZE_DEVICE_IIFORMAT): ditto. + (struct Lisp_Image_Instance): add widget and subwindow data plus + appropriate access functions. + + * glyphs.c (decode_device_ii_format): new function for decoding + image instantiator functions based on a device type as well as an + image format. + (decode_image_instantiator_format): just call + decode_device_ii_format with nil device. + (add_entry_to_device_ii_format_list): new function for per device + method instances. + (add_entry_to_image_instantiator_format_list): just call + add_entry_to_device_ii_format_list with nil device. + (check_valid_vector): new function. + (instantiate_image_instantiator): instantiate using per-format + method and then per-format-per-device method (device + multi-methods). signal an error if neither is possible. + (mark_image_instance): cope with subwindows and widgets. + (print_image_instance): ditto. + (image_instance_equal): ditto. + (image_instance_hash): ditto. + (allocate_glyph): ditto. + (glyph_width): ditto. + (glyph_height_internal): ditto. + (xpm_instantiate): removed because of device multi-methods. + (mark_subwindow_cachels): new cachel functions for caching + instantiated subwindows on a per-frame basis. mostly copied from + glyph cachel functions. + (update_subwindow_cachel_data): ditto. + (add_subwindow_cachel): ditto. + (get_subwindow_cachel_index): ditto. + (reset_subwindow_cachels): ditto. + (mark_subwindow_cachels_as_not_updated): ditto. + (unmap_subwindow): generic unmapping of subwindows based on cachel + data. + (map_subwindow): ditto. + (initialize_subwindow_image_instance): generic initialisation of + subwindow data. + (syms_of_glyphs): add widget keywords. + + * glyphs-x.h (struct x_subwindow_data): convert Lisp_Subwindow to + x_subwindow_data. + +1998-11-04 Andy Piper + + * glyphs-widget.c: new file for instantiating widget type glyphs. + (widget_possible_dest_types): new general dest type function for + widgets. + (widget_validate): ditto. + (initialize_widget_image_instance): ditto + (widget_instantiate): ditto. Sets up fg/bg, gui_item parsing + before handing on control to device multi-methods. + (syms_of_glyphs_widget): new function. + (image_instantiator_format_create_glyphs_widget): new function, + added placeholders for button, edit, combo, scrollbar + (vars_of_glyphs_widget): new function. + + * glyphs-msw.h (WIDGET_INSTANCE_MSWINDOWS_HANDLE): new define for + storing window ids of widgets. + + * glyphs-msw.c (mswindows_finalize_image_instance): cope with + deletion of widget and subwindow glyphs. + (mswindows_unmap_subwindow): new device function for unmapping + subwindows on a msw frame. + (mswindows_map_subwindow): ditto. + (mswindows_register_image_instance): register instantiated widgets + with the widget hastable. + (mswindows_button_instantiate): instantiate a button type widget + on an msw frame. + (mswindows_subwindow_instantiate): instanttiate a subwindow on a + mswindows frame. + (image_instantiator_format_create_glyphs_mswindows): add device + multi-methods for xbm, xpm, subwindow, edit and button. + + * frame.h (struct frame): add subwindow_cachels dynarr for caching + information about subwindows visible on the current frame. used by + redisplay_clear_region to unmap subwindows as required. + + * frame.c (mark_frame): mark subwindow_cachels. + (allocate_frame_core): instantiate subwindow_cachels. + + * frame-msw.c (mswindows_init_frame_1): instntiate and mark the + widget hashtable. + + * event-msw.c (mswindows_wnd_proc): add call to + mswindows_handle_gui_wm_command to handle widget callbacks. + + * emacs.c (main_1): add calls to glyphs-widget initialisation + routines. + + * console.h (struct console_methods): add + unmap/map_subwindow_method for use be redisplay_clear_region to + map and unmap subwindows. Remove xpm and xbm stuff - now dealt + with by image instantiator multi-methods. Add + resize_subwindow_method. + + * console-stream.c (stream_clear_region): change signature to + match new generic clear region function. + + * Makefile.in.in: add glyphs-widget.o to list of objects. + + * console-msw.h (struct mswindows_frame): add widget hashtable for + wiring command ids to callbacks. + 1998-12-16 Andy Piper * XEmacs 21.2.6 is released @@ -23,11 +673,11 @@ - Don't use variable name `new'. - Use size_t instead of EMACS_INT. - usual Martin-style pointless bit-twiddling. - - * fns.c (mapcar1): - (Fmapconcat): - (Fmapcar): - (Fmapvector): + + * fns.c (mapcar1): + (Fmapconcat): + (Fmapcar): + (Fmapvector): Make mapcar faster. In particular, make (mapc #'identity long-string) MUCH faster under Mule. @@ -35,7 +685,7 @@ 1998-12-06 Martin Buchholz - * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded + * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded bytecode. 1998-12-13 Martin Buchholz @@ -45,10 +695,10 @@ 1998-12-11 Martin Buchholz - * events.h (struct timeout_data): - * event-tty.c (tty_timeout_to_emacs_event): - * event-msw.c (mswindows_wm_timer_callback): - * event-Xt.c (Xt_timeout_to_emacs_event): + * events.h (struct timeout_data): + * event-tty.c (tty_timeout_to_emacs_event): + * event-msw.c (mswindows_wm_timer_callback): + * event-Xt.c (Xt_timeout_to_emacs_event): * event-msw.c (mswindows_cancel_dispatch_event): Make sure Lisp_Objects inside events are initialized to Qnil, not Qnull_pointer, which is now illegal. @@ -65,15 +715,15 @@ 1998-12-07 Martin Buchholz * opaque.h: - * console-msw.c (DHEADER): - (DOPAQUE_DATA): - (DEVENT): - (DCONS): - (DCONSCDR): - (DSTRING): - (DVECTOR): - (DSYMBOL): - (DSYMNAME): + * console-msw.c (DHEADER): + (DOPAQUE_DATA): + (DEVENT): + (DCONS): + (DCONSCDR): + (DSTRING): + (DVECTOR): + (DSYMBOL): + (DSYMNAME): - max_align_t should not be visible to the user of the XOPAQUE_DATA macro. - use Bufbyte instead of char @@ -83,7 +733,7 @@ 1998-12-07 Martin Buchholz - * sysdep.c (set_descriptor_non_blocking): + * sysdep.c (set_descriptor_non_blocking): Since O_NONBLOCK is now always #defined, make use of fcntl conditional on F_SETFL being defined. @@ -101,7 +751,7 @@ * windowsnt.h: Remove `support' for using index and rindex - * filelock.c (current_lock_owner): + * filelock.c (current_lock_owner): - Change uses of index -> strchr, rindex -> strrchr 1998-12-06 Martin Buchholz @@ -771,7 +1421,7 @@ - rewrite basic lisp functions for speed - rewrite bytecode interpreter for speed - rewrite list looping constructs for speed and safety using - tortoise/hare. + tortoise/hare. - use size_t where appropriate. - new hashtable implementation - cleanup implementation of opaques @@ -792,7 +1442,7 @@ - use O_RDONLY and O_RDWR instead of magic `0' and `2'. - define (and maybe use!) STDERR_FILENO and friends. - add support for macros defined in C - - `when', `unless', `not' and `defalias' now defined in C, + - `when', `unless', `not' and `defalias' now defined in C, so that they are universally available. - rename defvar_mumble to defvar_magic - rename RETURN__ to RETURN_SANS_WARNINGS @@ -837,7 +1487,7 @@ 1998-11-27 Hrvoje Niksic - * dired.c (make_directory_hash_table): make_string() is OK because + * dired.c (make_directory_hash_table): make_string() is OK because readdir() Mule-encapsulates. 1998-11-26 Hrvoje Niksic @@ -852,7 +1502,7 @@ 1998-11-25 Hrvoje Niksic - * editfns.c (Ftranslate_region): Accept vectors and char-tables as + * editfns.c (Ftranslate_region): Accept vectors and char-tables as well as strings. (Ftranslate_region): Turn table into an array of Emchars for larger regions. @@ -880,7 +1530,7 @@ * process-unix.c (unix_create_process): handle properly Vfile_name_coding_system for converting the program and directory - names. + names. 1998-11-27 SL Baur @@ -902,7 +1552,7 @@ * fns.c (free_malloced_ptr): New function. (XMALLOC_OR_ALLOCA): New macro. (XMALLOC_UNBIND): Ditto. - (Fbase64_encode_region): Use malloc() for large blocks; arrange it + (Fbase64_encode_region): Use malloc() for large blocks; arrange it to be freed in case of non-local exit. (Fbase64_encode_string): Ditto. (Fbase64_decode_region): Ditto. @@ -1015,7 +1665,7 @@ 1998-10-07 Jonathan Harris - * scrollbar-msw.c: Use the same vertical scrollbar drag hack as + * scrollbar-msw.c: Use the same vertical scrollbar drag hack as is used for Motif or Lucid scrollbars under X. 1998-10-08 Pierre Wendling @@ -1070,9 +1720,9 @@ mswindows_enumerate_fonts() function in objects-msw.c instead of font_enum_callback_1() to enumerate fonts. - font_enum_callback_1() and _2() moved to objects-msw.c. + font_enum_callback_1() and _2() moved to objects-msw.c. - * faces.c (complex_vars_of_faces): Make the mswindows default + * faces.c (complex_vars_of_faces): Make the mswindows default face font fully specified and provide some fallbacks. * objects-msw.c: font_enum_callback_1() and _2() moved here @@ -1100,7 +1750,7 @@ sig_enable_code_end() since they are now redundant. send_signal() and enable_child_signals(): Don't try to work - out the end of the code fragments passed to + out the end of the code fragments passed to run_in_other_process() 1998-09-10 Kazuyuki IENAGA @@ -1182,14 +1832,14 @@ * filelock.c: Replaced by version from FSF 20.2. Now implements locking by using symlinks which is NFS safe. However keep the - GCPRO's in lock_file and the calls to callx_in_buffer like our old + GCPRO's in lock_file and the calls to callx_in_buffer like our old version (and of course use ansi C, acessor macros, etc). 1998-09-06 Jan Vroonhof * process-unix.c (unix_create_process): Reset SIGHUP handler to SIG_DFL. We now try to conserve any inherted SIG_IGN settings - in init_signals_very_early. However these should not be passed + in init_signals_very_early. However these should not be passed on to children attached to the new pty. 1998-08-28 Andy Piper @@ -1199,7 +1849,7 @@ 1998-09-07 Jonathan Harris * fileio.c (file-name-directory, file_name_as_directory): - Don't call CORRECT_DIR_SEPS, even when #defined WINDOWSNT. + Don't call CORRECT_DIR_SEPS, even when #defined WINDOWSNT. 1998-09-02 Andy Piper @@ -1235,7 +1885,7 @@ * frame-x.c (x_delete_frame): Flush the X output buffer after calling XtDestroyWidget to ensure that the windows are really - killed right now. + killed right now. 1998-08-26 Hrvoje Niksic @@ -1263,7 +1913,7 @@ all the buffers. (buffer_delete_range): Ditto. - * marker.c (init_buffer_markers): Set point-marker to the value of + * marker.c (init_buffer_markers): Set point-marker to the value of point in an indirect buffer. 1998-08-30 Hrvoje Niksic @@ -1343,7 +1993,7 @@ 1998-08-07 Matt Stupple - * ntproc.c: don't wait on char_consumed at thread entry. + * ntproc.c: don't wait on char_consumed at thread entry. Additionally, to get the 'process' marked as finished, ensure that the CHILD_ACTIVE macro returns false, so before exiting close char_avail and set it to NULL, and close other handles @@ -1370,7 +2020,7 @@ 1998-07-20 Martin Buchholz - * casefiddle.c (casify_object): + * casefiddle.c (casify_object): Change algorithm from O(N**2) to O(N). Code cleanup. Doc string cleanup. @@ -1473,7 +2123,7 @@ 1998-07-16 Jan Vroonhof * event-Xt.c (x_to_emacs_keysym): Return nil for modifier keysyms. - (x_event_to_emacs_event): Let x_to_emacs_keysym check for modifier + (x_event_to_emacs_event): Let x_to_emacs_keysym check for modifier keys thus no longer considering all keysyms on a key. 1998-07-19 SL Baur @@ -1604,7 +2254,7 @@ * eval.c (run_hook_with_args_in_buffer): Check default (non-buffer-local) value of hook for - nil before treating it as a function. Don't initialize + nil before treating it as a function. Don't initialize the `globals' variable twice. 1998-06-24 Jonathan Harris @@ -1635,7 +2285,7 @@ * eval.c (run_hook_with_args_in_buffer): Don't treat the default value of a buffer local hook as a list of - hooks unless it is both a cons and the car of that cons + hooks unless it is both a cons and the car of that cons is not Qlambda. 1998-06-29 SL Baur @@ -1665,7 +2315,7 @@ * winslots.h: Rename. * window.c (specifier_vars_of_window): Renamed - vertical-divider-draggable-p to vertical-divider-always-visible-p, + vertical-divider-draggable-p to vertical-divider-always-visible-p, as suggested by Ben Wing. (specifier_vars_of_window): Fix docstrings. @@ -1701,7 +2351,7 @@ Set last_known_column_point to the buffer position for which the column was requested, not buffer's point. - * redisplay.c (decode_mode_spec): for current-column, show + * redisplay.c (decode_mode_spec): for current-column, show window's point's column, not buffer's point's column. 1998-06-23 Andy Piper @@ -1800,7 +2450,7 @@ mswindows_size_frame_internal function and size frame if frame parameters not just if init is finished - WM_SIZE happens too early for some specs. (mswindows_size_frame_internal): new - function abstracted from mswindows_set_frame_properties. + function abstracted from mswindows_set_frame_properties. (Vmswindows_use_system_frame_size_defaults): new variable controls whether to allow the system to pick frame size defaults, defaults to nil. @@ -1824,7 +2474,7 @@ 1998-06-05 Hrvoje Niksic - * eldap.c (Fldap_search_internal): Use build_ext_string instead of + * eldap.c (Fldap_search_internal): Use build_ext_string instead of build_string to avoid crashes under Mule. 1998-06-13 Andy Piper @@ -2017,7 +2667,7 @@ * glyphs-msw.c (read_bitmap_data) (NextInt) (read_bitmap_data_from_file): new functions copied from Xmu - sources. + sources. (xbm_create_bitmap_from_data) from Ben convert inline data to an mswindows bitmap. (init_image_instance_from_xbm_inline) (xbm_instantiate_1) @@ -2063,7 +2713,7 @@ Added prototype for mswindows_enqueue_misc_user_event(). * menubar-msw.c (mswindows_handle_wm_command): Use - mswindows_enqueue_misc_user_event(). + mswindows_enqueue_misc_user_event(). * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. @@ -2076,11 +2726,11 @@ 1998-05-29 Greg Klanderman * window.c (Fwindow_displayed_text_pixel_height): was relying on - incorrect semantics of vmotion_pixels which has been fixed. don't + incorrect semantics of vmotion_pixels which has been fixed. don't use it anymore as it can't easily be used. * indent.c (vmotion_pixels): fix off by one bug moving up. also - the motion was reported incorrectly if you tried to go past end of + the motion was reported incorrectly if you tried to go past end of buffer. 1998-05-30 Kirill M. Katsnelson @@ -2106,11 +2756,11 @@ 1998-05-28 Martin Buchholz - * alloc.c (dbg_constants): + * alloc.c (dbg_constants): * dbxrc: * gdbinit: Remove toolbar_data debugging code, since that lrecord has - also been removed. + also been removed. Wed May 27, 1998 Darryl Okahata @@ -2141,7 +2791,7 @@ Wed May 27, 1998 Darryl Okahata * fileio.c: replaced egetenv("HOME") with calls to the new get_home_directory(). - * lisp.h: Added function prototypes for uncache_home_directory() + * lisp.h: Added function prototypes for uncache_home_directory() and get_home_directory(), along with lisp prototypes for Fuser_home_directory() and friends. @@ -2158,7 +2808,7 @@ Wed May 27, 1998 Darryl Okahata * event-msw.c (mswindows_wnd_proc, WM_KEYDOWN): Unconditionally remove MOD_SHIFT from ASCII characters. - (mswindows_wnd_proc, WM_KEYDOWN): Do not activate the menubar when + (mswindows_wnd_proc, WM_KEYDOWN): Do not activate the menubar when F10 is pressed. 1998-05-24 Oliver Graf @@ -2195,10 +2845,10 @@ Wed May 27, 1998 Darryl Okahata (syms_of_indent): DEFSUBR. * lisp.h: declaration for vmotion_pixels(). - * indent.c (Fvertical_motion): Add optional third argument PIXELS, + * indent.c (Fvertical_motion): Add optional third argument PIXELS, to request returning motion in pixels. (Fvertical_motion_pixels): Remove, functionality merged into - Fvertical_motion. + Fvertical_motion. * window.c (window_scroll): call Fvertical_motion with 3 arguments. (Fmove_to_window_line): ditto. * lisp.h: Change declaration for Fvertical_motion. @@ -2212,7 +2862,7 @@ Wed May 27, 1998 Darryl Okahata Tooltalk_Message_plist_str and Tooltalk_Pattern_plist_str 1998-05-27 Andy Piper - + * faces.c: create a new 3d_object_face, make modeline and vertical_divider faces fallback to this rather than the default. @@ -2260,9 +2910,9 @@ Wed May 27, 1998 Darryl Okahata * This patch is to fix compilation warnings under Windows. * s/windowsnt.h: Encapsulate getpid with sys_getpid. - Added prototypes for FSF inherited functions, with which XEmacs is + Added prototypes for FSF inherited functions, with which XEmacs is sprinkled thoroughly. - Removed some #if 0 code. Bracketed some more definitions, probably + Removed some #if 0 code. Bracketed some more definitions, probably related to Visual C versions prior to 4 (we do not support them). * sysfloat.h (logb): Finally, get logb() prototyped. @@ -2278,10 +2928,10 @@ Wed May 27, 1998 Darryl Okahata vars_of_dired_mswindows and init_ntproc (Grrr). * realpath.c: Added Windows specific include files. - (xrealpath): Conditionalized declaration of some auto variables on + (xrealpath): Conditionalized declaration of some auto variables on S_IFLNK, to avoid warnings. - * ntproc.c: Disabled some compiler warnings. This file is going to + * ntproc.c: Disabled some compiler warnings. This file is going to die, so I have not cleaned it up much. (set_process_dir): Const parameter. (Fwin32_short_file_name): Down CHECK_* macros to one argument. @@ -2357,7 +3007,7 @@ Wed May 27, 1998 Darryl Okahata * symsinit.h: Prototyped the above functions. - * dialog-x.c (x_popup_dialog_box): Moved dialog descriptor consistency + * dialog-x.c (x_popup_dialog_box): Moved dialog descriptor consistency checks to dialog.c... * dialog.c (Fpopup_dialog_box): ...right here. Added more checks: a @@ -2410,7 +3060,7 @@ Wed May 27, 1998 Darryl Okahata * EmacsFrame.c (Xt_StringToScrollBarPlacement): Added support for {top,bottom}-{left,right} values in addition to - {top,bottom}_{left,right}. + {top,bottom}_{left,right}. 1998-05-18 Hrvoje Niksic @@ -2421,10 +3071,10 @@ Wed May 27, 1998 Darryl Okahata 1998-05-19 Martin Buchholz - * unexhp9k800.c: - * sound.c (vars_of_sound): - * sysdep.c (reset_sigio_on_device): - * window.c (window_bottom_gutter_height): + * unexhp9k800.c: + * sound.c (vars_of_sound): + * sysdep.c (reset_sigio_on_device): + * window.c (window_bottom_gutter_height): unexhp9k800.c:258: warning: implicit declaration of function `calculate_checksum' sound.c:604: warning: implicit declaration of function `vars_of_hpplay' @@ -2454,7 +3104,7 @@ Wed May 27, 1998 Darryl Okahata * frame-x.c (x_update_frame_external_traits): Start preprocessor directives in column 1. - * search.c (skip_chars): Avoid using xzero with arrays, since some + * search.c (skip_chars): Avoid using xzero with arrays, since some compilers get confused by the construct &array. 1998-05-18 Kirill M. Katsnelson @@ -2478,7 +3128,7 @@ Wed May 27, 1998 Darryl Okahata 1998-05-18 Kirill M. Katsnelson * objects-msw.c (mswindows_initialize_font_instance): Use ANSI - charset when creating font. + charset when creating font. (mswindows_initialize_color_instance): Do not create brush along with a color. (mswindows_finalize_color_instance): Do not delete it then. @@ -2502,7 +3152,7 @@ Wed May 27, 1998 Darryl Okahata (compute_frame_toolbars_data): Removed unused second parameter; Adjusted callers of this static function throughout the file. (init_frame_toolbars): Initialize current_toolbar_size. - (update_frame_toolbars): Use DEVICE_SUPPORTS_TOOLBARS_P instead of + (update_frame_toolbars): Use DEVICE_SUPPORTS_TOOLBARS_P instead of what is its current expansion, for clarity. (init_frame_toolbars): Ditto. (init_device_toolbars): Ditto. @@ -2547,7 +3197,7 @@ Wed May 27, 1998 Darryl Okahata * emacs.c (main_1): Call syms_of_process_nt() - * process-nt.c: Quote process arguments by a call to Lisp function + * process-nt.c: Quote process arguments by a call to Lisp function `nt-quote-process-args'. (syms_of_process_nt): New function. (nt_send_process): Flush data stream after each write, to avoid @@ -2572,7 +3222,7 @@ Wed May 27, 1998 Darryl Okahata 1998-05-17 Michael Sperber [Mr. Preprocessor] - * s/aix4-2.h (ALIGN_DATA_RELOC): Undefined to support new unexaix.c. + * s/aix4-2.h (ALIGN_DATA_RELOC): Undefined to support new unexaix.c. * s/aix3-1.h (ALIGN_DATA_RELOC): Defined to support new unexaix.c. @@ -2644,7 +3294,7 @@ Wed May 27, 1998 Darryl Okahata * bufslots.h: Removed buffer_file_type slot. - * buffer.c (complex_vars_of_buffer): Removed buffer_file_type from + * buffer.c (complex_vars_of_buffer): Removed buffer_file_type from buffer local flags. (complex_vars_of_buffer): Removed buffer-file-type variable and its default reference. @@ -2673,9 +3323,9 @@ Wed May 27, 1998 Darryl Okahata (x_divider_width): ditto. * window.c (specifier_vars_of_window): new specifiers: - vertical-divier -line-width and -spacing. + vertical-divier -line-width and -spacing. (vertical_divider_global_width_changed): formerly known as - vertical_divider_shadow_thickness_changed. + vertical_divider_shadow_thickness_changed. * winslots.h: new slots: vertical_specifier _line_width and _spacing. Plus corrected a comment typo. @@ -2688,7 +3338,7 @@ Wed May 27, 1998 Darryl Okahata (console_type_create_stream): And declaration for it. * redisplay.c (pixel_to_glyph_translation): Use - window_divider_width() instead of divider_width redisplay method. + window_divider_width() instead of divider_width redisplay method. (pixel_to_glyph_translation): Fix top divider edge calculation when scrollbar is on top. @@ -2698,7 +3348,7 @@ Wed May 27, 1998 Darryl Okahata (specifier_vars_of_window): For vertical-divider-{spacing,line-width} specifiers, set fallback values differently on TTYs, and document the behavior of these on TTYs in the docstrings. - + * scrollbar.c (update_scrollbar_instance): Use window_divider_width() instead of divider_width redisplay method. @@ -2753,7 +3403,7 @@ Wed May 27, 1998 Darryl Okahata * emacs.c (main_1): Call console_type_create_dialog_x(). - * dialog-x.c (x_popup_dialog_box): Old Fpopup_dialog_box converted + * dialog-x.c (x_popup_dialog_box): Old Fpopup_dialog_box converted into this device method. (console_type_create_dialog_x): New function. @@ -2761,7 +3411,7 @@ Wed May 27, 1998 Darryl Okahata (syms_of_dialog): Defsubr it. * console.h (struct console_methods): Declared - popup_dialog_box_method(). + popup_dialog_box_method(). * symsinit.h: Defined console_type_create_dialog_{x,mswindows} @@ -2799,10 +3449,10 @@ Wed May 27, 1998 Darryl Okahata ** Renamed window-divider-map => vertical-divider-map and event-over-divider-p => event-over-vertical-divider-p, in the following files/functions: - * events.h: - * events.c (Fevent_over_divider_p): - * keymap.c (get_relevant_keymaps): - (vars_of_keymap): + * events.h: + * events.c (Fevent_over_divider_p): + * keymap.c (get_relevant_keymaps): + (vars_of_keymap): * redisplay.h (OVER_V_DIVIDER): Renamed so from OVER_DIVIDER. @@ -2825,7 +3475,7 @@ Wed May 27, 1998 Darryl Okahata * window.h: Prototype invalidate_vertical_divider_cache_in_window. (struct window): Added need_vertical_divider_p and - need_vertical_divider_valid_p. + need_vertical_divider_valid_p. * winslots.h: Added vertical_divider_draggable_p slot. @@ -2881,7 +3531,7 @@ Wed May 27, 1998 Darryl Okahata thickness is negative. * console-stream.c (stream_divider_width): pass a struct window * - argument. + argument. * redisplay-tty.c (tty_divider_width): ditto. @@ -2890,12 +3540,12 @@ Wed May 27, 1998 Darryl Okahata * redisplay.c (generate_modeline): ittod. * scrollbar.c (update_scrollbar_instance): ttido. - - * redisplay-msw.c (mswindows_divider_width): ottid. + + * redisplay-msw.c (mswindows_divider_width): ottid. WARNING: this enables to compile, but the feature is not functional. * window.h (struct window): new field - vertical_divider_shadow_thickness. + vertical_divider_shadow_thickness. * window.c (specifier_vars_of_window): new specifier vertical-divider-shadow-thickness. @@ -2946,7 +3596,7 @@ Wed May 27, 1998 Darryl Okahata 1998-05-10 Andy Piper * redisplay-msw.c (mswindows_output_dibitmap_region): make sure - multiple bitmaps are output vertically as well as horizontally. + multiple bitmaps are output vertically as well as horizontally. * (mswindows_output_dibitmap): don't cope with bitmap boundaries crossing lines this is handled by mswindows_output_dibitmap_region. @@ -2955,7 +3605,7 @@ Wed May 27, 1998 Darryl Okahata * inline.c: Include eldap.h - * menubar-x.c (x_update_frame_menubar_internal): + * menubar-x.c (x_update_frame_menubar_internal): Remove: unused variable `container' 1998-05-11 Martin Buchholz @@ -2963,8 +3613,8 @@ Wed May 27, 1998 Darryl Okahata * s/aix4.h: Allow AIX 4.3 XEmacs to compile cleanly. Unfortunately, the resulting temacs still cannot dump. - * symbols.c (symbol_is_constant): - (verify_ok_for_buffer_local): + * symbols.c (symbol_is_constant): + (verify_ok_for_buffer_local): -Wswitch Warning suppression - add default case to switches. * redisplay.c (decode_mode_spec): Remove unused variables, @@ -3011,7 +3661,7 @@ Wed May 27, 1998 Darryl Okahata 1998-05-12 Didier Verna * redisplay.c: removed the scrolling modeline code that didn't - make it for 21.0. To be continued ... + make it for 21.0. To be continued ... 1998-05-13 Michael Sperber [Mr. Preprocessor] @@ -3068,7 +3718,7 @@ Wed May 27, 1998 Darryl Okahata (mswindows_output_vertical_divider): Always output the divider on the right side of a window, down to bottom. - * keymap.c (get_relevant_keymaps): Route mouse button events which + * keymap.c (get_relevant_keymaps): Route mouse button events which happened over a window divider through window-divider-map. (Fkey_binding): Documented that in the docstring. Defined the variable Vwindow_divider_map. @@ -3117,7 +3767,7 @@ Wed May 27, 1998 Darryl Okahata (metrics); Changed parameters order and added DEFAULT parameter; Unabbreviated some metric constants; Fixed and untabified doc string. (Fdevice_system_metrics): Added. Returns a plist of all provided - metrics. + metrics. * device-msw.c (mswindows_device_system_metrics): Renamed device_metrics enum constants. diff --git a/src/Makefile.in.in b/src/Makefile.in.in index 0aaaeef..bbb3127 100644 --- a/src/Makefile.in.in +++ b/src/Makefile.in.in @@ -174,8 +174,8 @@ objs=\ eval.o events.o $(extra_objs)\ event-stream.o extents.o faces.o\ fileio.o $(LOCK_OBJ) filemode.o floatfns.o fns.o font-lock.o\ - frame.o general.o getloadavg.o glyphs.o glyphs-eimage.o\ - $(gui_objs) hash.o imgproc.o indent.o insdel.o intl.o\ + frame.o general.o getloadavg.o glyphs.o glyphs-eimage.o glyphs-widget.o\ + gui.o $(gui_objs) hash.o imgproc.o indent.o insdel.o intl.o\ keymap.o $(RTC_patch_objs) line-number.o lread.o lstream.o\ macros.o marker.o md5.o minibuf.o objects.o opaque.o\ print.o process.o profile.o\ diff --git a/src/callproc.c b/src/callproc.c index b2c3061..808d930 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -823,13 +823,12 @@ void init_callproc (void) { /* This function can GC */ - REGISTER char *sh; - Vprocess_environment = Qnil; - /* jwz: always initialize Vprocess_environment, so that egetenv() works - in temacs. */ { + /* jwz: always initialize Vprocess_environment, so that egetenv() + works in temacs. */ char **envp; + Vprocess_environment = Qnil; for (envp = environ; envp && *envp; envp++) { Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS), @@ -837,32 +836,18 @@ init_callproc (void) } } + { + /* Initialize shell-file-name from environment variables or best guess. */ #ifdef WINDOWSNT - /* Sync with FSF Emacs 19.34.6 note: this is not in 19.34.6. --marcpa */ - /* - ** If NT then we look at COMSPEC for the shell program. - */ - sh = egetenv ("COMSPEC"); - /* - ** If COMSPEC has been set, then convert the - ** DOS formatted name into a UNIX format. Then - ** create a LISP object. - */ - if (sh) - Vshell_file_name = build_string (sh); - /* - ** Odd, no COMSPEC, so let's default to our - ** best guess for NT. - */ - else - Vshell_file_name = build_string ("\\WINNT\\system32\\cmd.exe"); - + CONST char *shell = egetenv ("COMSPEC"); + if (!shell) shell = "\\WINNT\\system32\\cmd.exe"; #else /* not WINDOWSNT */ - - sh = (char *) egetenv ("SHELL"); - Vshell_file_name = build_string (sh ? sh : "/bin/sh"); - + CONST char *shell = egetenv ("SHELL"); + if (!shell) shell = "/bin/sh"; #endif + + Vshell_file_name = build_string (shell); + } } #if 0 diff --git a/src/console-msw.h b/src/console-msw.h index 2f48d95..25d3293 100644 --- a/src/console-msw.h +++ b/src/console-msw.h @@ -153,6 +153,9 @@ struct mswindows_frame /* Menu checksum. See menubar-msw.c */ unsigned int menu_checksum; + /* Widget glyphs attached to this frame. See glyphs-msw.c */ + Lisp_Object widget_hash_table; + /* Frame title hash value. See frame-msw.c */ unsigned int title_checksum; @@ -181,6 +184,8 @@ struct mswindows_frame #define FRAME_MSWINDOWS_MENU_HASH_TABLE(f) (FRAME_MSWINDOWS_DATA (f)->menu_hash_table) #define FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) \ (FRAME_MSWINDOWS_DATA (f)->toolbar_hash_table) +#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE(f) \ + (FRAME_MSWINDOWS_DATA (f)->widget_hash_table) #define FRAME_MSWINDOWS_TOOLBAR_CHECKSUM(f,pos) \ (FRAME_MSWINDOWS_DATA (f)->toolbar_checksum[pos]) #define FRAME_MSWINDOWS_MENU_CHECKSUM(f) (FRAME_MSWINDOWS_DATA (f)->menu_checksum) diff --git a/src/console-stream.c b/src/console-stream.c index 393d19d..74d8e4a 100644 --- a/src/console-stream.c +++ b/src/console-stream.c @@ -241,8 +241,10 @@ stream_clear_to_window_end (struct window *w, int ypos1, int ypos2) } static void -stream_clear_region (Lisp_Object locale, face_index findex, int x, int y, - int width, int height) +stream_clear_region (Lisp_Object window, struct device* d, struct frame * f, + face_index findex, int x, int y, + int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, + Lisp_Object background_pixmap) { } diff --git a/src/console-tty.c b/src/console-tty.c index 24fa971..ec63358 100644 --- a/src/console-tty.c +++ b/src/console-tty.c @@ -233,7 +233,7 @@ Return the controlling process of tty console CONSOLE. return CONSOLE_TTY_DATA (decode_tty_console (console))->controlling_process; } -#ifdef MULE +#ifdef FILE_CODING DEFUN ("console-tty-input-coding-system", Fconsole_tty_input_coding_system, 0, 1, 0, /* @@ -298,7 +298,7 @@ output coding systems of CONSOLE. Fset_console_tty_output_coding_system (console, codesys); return Qnil; } -#endif /* MULE */ +#endif /* FILE_CODING */ Lisp_Object @@ -341,13 +341,13 @@ syms_of_console_tty (void) DEFSUBR (Fconsole_tty_controlling_process); defsymbol (&Qterminal_type, "terminal-type"); defsymbol (&Qcontrolling_process, "controlling-process"); -#ifdef MULE +#ifdef FILE_CODING DEFSUBR (Fconsole_tty_output_coding_system); DEFSUBR (Fset_console_tty_output_coding_system); DEFSUBR (Fconsole_tty_input_coding_system); DEFSUBR (Fset_console_tty_input_coding_system); DEFSUBR (Fset_console_tty_coding_system); -#endif /* MULE */ +#endif /* FILE_CODING */ } void diff --git a/src/console.h b/src/console.h index 757a492..034c585 100644 --- a/src/console.h +++ b/src/console.h @@ -139,7 +139,9 @@ struct console_methods int (*eol_cursor_width_method) (void); void (*output_vertical_divider_method) (struct window *, int); void (*clear_to_window_end_method) (struct window *, int, int); - void (*clear_region_method) (Lisp_Object, face_index, int, int, int, int); + void (*clear_region_method) (Lisp_Object, struct device*, struct frame*, face_index, + int, int, int, int, + Lisp_Object, Lisp_Object, Lisp_Object); void (*clear_frame_method) (struct frame *); void (*output_begin_method) (struct device *); void (*output_end_method) (struct device *); @@ -202,6 +204,10 @@ struct console_methods Lisp_Object printcharfun, int escapeflag); void (*finalize_image_instance_method) (struct Lisp_Image_Instance *); + void (*unmap_subwindow_method) (struct Lisp_Image_Instance *); + void (*map_subwindow_method) (struct Lisp_Image_Instance *, int x, int y); + void (*resize_subwindow_method) (struct Lisp_Image_Instance *, int w, int h); + void (*update_subwindow_method) (struct Lisp_Image_Instance *); int (*image_instance_equal_method) (struct Lisp_Image_Instance *, struct Lisp_Image_Instance *, int depth); @@ -216,22 +222,6 @@ struct console_methods Lisp_Object (*locate_pixmap_file_method) (Lisp_Object file_method); int (*colorize_image_instance_method) (Lisp_Object image_instance, Lisp_Object fg, Lisp_Object bg); -#ifdef HAVE_XPM - /* which is more tacky - this or #defines in glyphs.c? */ - void (*xpm_instantiate_method)(Lisp_Object image_instance, - Lisp_Object instantiator, - Lisp_Object pointer_fg, - Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain); -#endif -#ifdef HAVE_WINDOW_SYSTEM - /* which is more tacky - this or #defines in glyphs.c? */ - void (*xbm_instantiate_method)(Lisp_Object image_instance, - Lisp_Object instantiator, - Lisp_Object pointer_fg, - Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain); -#endif Lisp_Object image_conversion_list; #ifdef HAVE_TOOLBARS diff --git a/src/device-x.c b/src/device-x.c index ff63865..0ffbd65 100644 --- a/src/device-x.c +++ b/src/device-x.c @@ -622,7 +622,7 @@ x_delete_device (struct device *d) Lisp_Object device; Display *display; #ifdef FREE_CHECKING - extern void (*__free_hook)(); + extern void (*__free_hook) (void *); int checking_free; #endif diff --git a/src/device.c b/src/device.c index de3c8df..4c1feab 100644 --- a/src/device.c +++ b/src/device.c @@ -76,7 +76,6 @@ Lisp_Object Qdevicep, Qdevice_live_p; Lisp_Object Qdelete_device; Lisp_Object Qcreate_device_hook; Lisp_Object Qdelete_device_hook; - Lisp_Object Vdevice_class_list; @@ -883,6 +882,7 @@ behavior cannot necessarily be determined automatically. recompute_all_cached_specifiers_in_frame (f); MARK_FRAME_FACES_CHANGED (f); MARK_FRAME_GLYPHS_CHANGED (f); + MARK_FRAME_SUBWINDOWS_CHANGED (f); MARK_FRAME_TOOLBARS_CHANGED (f); f->menubar_changed = 1; } diff --git a/src/device.h b/src/device.h index 9b52dff..aad12fd 100644 --- a/src/device.h +++ b/src/device.h @@ -167,6 +167,7 @@ struct device unsigned int faces_changed :1; unsigned int frame_changed :1; unsigned int glyphs_changed :1; + unsigned int subwindows_changed :1; unsigned int icon_changed :1; unsigned int menubar_changed :1; unsigned int modeline_changed :1; @@ -343,6 +344,9 @@ int valid_device_class_p (Lisp_Object class); #define MARK_DEVICE_GLYPHS_CHANGED(d) \ ((void) (glyphs_changed = (d)->glyphs_changed = 1)) +#define MARK_DEVICE_SUBWINDOWS_CHANGED(d) \ + ((void) (subwindows_changed = (d)->subwindows_changed = 1)) + #define MARK_DEVICE_TOOLBARS_CHANGED(d) \ ((void) (toolbar_changed = (d)->toolbar_changed = 1)) diff --git a/src/dired.c b/src/dired.c index c2309f1..e2aed07 100644 --- a/src/dired.c +++ b/src/dired.c @@ -180,7 +180,7 @@ If FILES-ONLY is the symbol t, then only the "files" in the directory { Lisp_Object name = - make_ext_string ((Bufbyte *)dp->d_name, len, FORMAT_FILENAME); + make_string ((Bufbyte *)dp->d_name, len); if (!NILP (full)) name = concat2 (dirname, name); diff --git a/src/eldap.c b/src/eldap.c index b55d07d..0b7117f 100644 --- a/src/eldap.c +++ b/src/eldap.c @@ -26,6 +26,7 @@ Boston, MA 02111-1307, USA. */ conforming to the API defined in RFC 1823. It has been tested with: - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) + - OpenLDAP 1.0.3 (http://www.openldap.org/) - Netscape's LDAP SDK 1.0 (http://developer.netscape.com) */ @@ -33,6 +34,7 @@ Boston, MA 02111-1307, USA. */ #include "lisp.h" #include "opaque.h" #include "sysdep.h" +#include "buffer.h" #include @@ -244,15 +246,13 @@ the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. else if (EQ (keyword, Qbinddn)) { CHECK_STRING (value); - ldap_binddn = alloca (XSTRING_LENGTH (value) + 1); - strcpy (ldap_binddn, (char *)XSTRING_DATA (value)); + GET_C_STRING_OS_DATA_ALLOCA (value, ldap_binddn); } /* Password */ else if (EQ (keyword, Qpasswd)) { CHECK_STRING (value); - ldap_passwd = alloca (XSTRING_LENGTH (value) + 1); - strcpy (ldap_passwd, (char *)XSTRING_DATA (value)); + GET_C_STRING_OS_DATA_ALLOCA (value, ldap_passwd); } /* Deref */ else if (EQ (keyword, Qderef)) @@ -454,11 +454,7 @@ an alist of attribute/values. { Lisp_Object current = XCAR (attrs); CHECK_STRING (current); - ldap_attributes[i] = - alloca_array (char, 1 + XSTRING_LENGTH (current)); - /* XSTRING_LENGTH is increased by one in order to copy the final 0 */ - memcpy (ldap_attributes[i], - XSTRING_DATA (current), 1 + XSTRING_LENGTH (current)); + GET_C_STRING_OS_DATA_ALLOCA (current, ldap_attributes[i]); ++i; } ldap_attributes[i] = NULL; diff --git a/src/emacs.c b/src/emacs.c index 89784aa..4a6ab91 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -920,6 +920,7 @@ main_1 (int argc, char **argv, char **envp, int restart) syms_of_general (); syms_of_glyphs (); syms_of_glyphs_eimage (); + syms_of_glyphs_widget (); #if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) syms_of_gui (); #endif @@ -1170,6 +1171,7 @@ main_1 (int argc, char **argv, char **envp, int restart) image_instantiator_format_create (); image_instantiator_format_create_glyphs_eimage (); + image_instantiator_format_create_glyphs_widget (); #ifdef HAVE_X_WINDOWS image_instantiator_format_create_glyphs_x (); #endif /* HAVE_X_WINDOWS */ @@ -1300,6 +1302,7 @@ main_1 (int argc, char **argv, char **envp, int restart) vars_of_frame (); vars_of_glyphs (); vars_of_glyphs_eimage (); + vars_of_glyphs_widget (); #if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) vars_of_gui (); #endif @@ -2152,7 +2155,7 @@ main (int argc, char **argv, char **envp) /* GCC >= 2.8. -slb */ #if defined(GNU_MALLOC) static void -voodoo_free_hook(void *mem) +voodoo_free_hook (void *mem) { /* Disable all calls to free() when XEmacs is exiting and it doesn't */ /* matter. */ @@ -2410,8 +2413,6 @@ and announce itself normally when it is run. /* When we're dumping, we can't use the debugging free() */ disable_free_hook (); #endif -#if 1 /* martin */ -#endif CHECK_STRING (intoname); intoname = Fexpand_file_name (intoname, Qnil); diff --git a/src/event-msw.c b/src/event-msw.c index 990f319..c2b0030 100644 --- a/src/event-msw.c +++ b/src/event-msw.c @@ -28,6 +28,7 @@ Boston, MA 02111-1307, USA. */ Ultimately based on FSF. Rewritten by Ben Wing. Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. + Subprocess and modal loop support by Kirill M. Katsnelson. */ #include @@ -50,6 +51,8 @@ Boston, MA 02111-1307, USA. */ #include "device.h" #include "events.h" #include "frame.h" +#include "buffer.h" +#include "faces.h" #include "lstream.h" #include "process.h" #include "redisplay.h" @@ -57,6 +60,7 @@ Boston, MA 02111-1307, USA. */ #include "syswait.h" #include "systime.h" #include "sysdep.h" +#include "objects-msw.h" #include "events-mod.h" #ifdef HAVE_MSG_SELECT @@ -84,6 +88,8 @@ extern Lisp_Object mswindows_get_toolbar_button_text (struct frame* f, int command_id); extern Lisp_Object mswindows_handle_toolbar_wm_command (struct frame* f, HWND ctrl, WORD id); +extern Lisp_Object +mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, WORD id); static Lisp_Object mswindows_find_frame (HWND hwnd); static Lisp_Object mswindows_find_console (HWND hwnd); @@ -118,8 +124,13 @@ static Lisp_Object mswindows_s_dispatch_event_queue, mswindows_s_dispatch_event_ /* List of mswindows waitable handles. */ static HANDLE mswindows_waitable_handles[MAX_WAITABLE]; +#ifndef HAVE_MSG_SELECT /* Number of wait handles */ static int mswindows_waitable_count=0; +#endif /* HAVE_MSG_SELECT */ +/* Brush for painting widgets */ +static HBRUSH widget_brush = 0; +static LONG last_widget_brushed = 0; /* Count of quit chars currently in the queue */ /* Incremented in WM_[SYS]KEYDOWN handler in the mswindows_wnd_proc() @@ -470,6 +481,7 @@ struct ntpipe_shove_stream DEFINE_LSTREAM_IMPLEMENTATION ("ntpipe-output", lstream_ntpipe_shove, sizeof (struct ntpipe_shove_stream)); +#ifndef HAVE_MSG_SELECT static DWORD WINAPI shove_thread (LPVOID vparam) { @@ -541,6 +553,7 @@ get_ntpipe_output_stream_param (Lstream *stream) struct ntpipe_shove_stream* s = NTPIPE_SHOVE_STREAM_DATA(stream); return s->user_data; } +#endif static int ntpipe_shove_writer (Lstream *stream, const unsigned char *data, size_t size) @@ -939,6 +952,13 @@ mswindows_enqueue_mouse_button_event (HWND hwnd, UINT message, POINTS where, DWO { event->event_type = button_press_event; SetCapture (hwnd); + /* we need this to make sure the main window regains the focus + from control subwindows */ + if (GetFocus() != hwnd) + { + SetFocus (hwnd); + mswindows_enqueue_magic_event (hwnd, WM_SETFOCUS); + } } else { @@ -997,18 +1017,18 @@ mswindows_dequeue_dispatch_event () /* * Remove and return the first emacs event on the dispatch queue that matches - * the supplied event - * Timeout event matches if interval_id equals to that of the given event. + * the supplied event. + * Timeout event matches if interval_id is equal to that of the given event. * Keypress event matches if logical AND between modifiers bitmask of the - * event in the queue and that of the given event is non-zero - * For all other event types, this function asserts. + * event in the queue and that of the given event is non-zero. + * For all other event types, this function aborts. */ Lisp_Object -mswindows_cancel_dispatch_event (struct Lisp_Event* match) +mswindows_cancel_dispatch_event (struct Lisp_Event *match) { Lisp_Object event; - Lisp_Object previous_event=Qnil; + Lisp_Object previous_event = Qnil; int user_p = mswindows_user_event_p (match); Lisp_Object* head = user_p ? &mswindows_u_dispatch_event_queue : &mswindows_s_dispatch_event_queue; @@ -1020,19 +1040,12 @@ mswindows_cancel_dispatch_event (struct Lisp_Event* match) EVENT_CHAIN_LOOP (event, *head) { - int found = 1; - if (XEVENT_TYPE (event) != match->event_type) - found = 0; - if (found && match->event_type == timeout_event - && (XEVENT(event)->event.timeout.interval_id != - match->event.timeout.interval_id)) - found = 0; - if (found && match->event_type == key_press_event - && ((XEVENT(event)->event.key.modifiers & - match->event.key.modifiers) == 0)) - found = 0; - - if (found) + struct Lisp_Event *e = XEVENT (event); + if ((e->event_type == match->event_type) && + ((e->event_type == timeout_event) ? + (e->event.timeout.interval_id == match->event.timeout.interval_id) : + /* Must be key_press_event */ + ((e->event.key.modifiers & match->event.key.modifiers) != 0))) { if (NILP (previous_event)) dequeue_event (head, tail); @@ -1050,6 +1063,7 @@ mswindows_cancel_dispatch_event (struct Lisp_Event* match) return Qnil; } +#ifndef HAVE_MSG_SELECT /************************************************************************/ /* Waitable handles manipulation */ /************************************************************************/ @@ -1085,6 +1099,7 @@ remove_waitable_handle (HANDLE h) mswindows_waitable_handles [ix] = mswindows_waitable_handles [--mswindows_waitable_count]; } +#endif /* HAVE_MSG_SELECT */ /************************************************************************/ @@ -1214,6 +1229,14 @@ mswindows_drain_windows_queue () MSG msg; while (PeekMessage (&msg, NULL, 0, 0, PM_REMOVE)) { + /* we have to translate messages that are not sent to the main + window. this is so that key presses work ok in things like + edit fields. however, we *musn't* translate message for the + main window as this is handled in the wnd proc. */ + if ( GetWindowLong (msg.hwnd, GWL_STYLE) & WS_CHILD ) + { + TranslateMessage (&msg); + } DispatchMessage (&msg); mswindows_unmodalize_signal_maybe (); } @@ -1648,7 +1671,8 @@ mswindows_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) { int quit_ch = CONSOLE_QUIT_CHAR (XCONSOLE (mswindows_find_console (hwnd))); BYTE keymap_orig[256]; - MSG msg = { hwnd, message, wParam, lParam, GetMessageTime(), (GetMessagePos()) }; + POINT pnt = { LOWORD (GetMessagePos()), HIWORD (GetMessagePos()) }; + MSG msg = { hwnd, message, wParam, lParam, GetMessageTime(), pnt }; /* GetKeyboardState() does not work as documented on Win95. We have * to loosely track Left and Right modifiers on behalf of the OS, @@ -1918,7 +1942,8 @@ mswindows_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) { /* I think this is safe since the text will only go away when the toolbar does...*/ - tttext->lpszText=XSTRING_DATA (btext); + GET_C_STRING_EXT_DATA_ALLOCA (btext, FORMAT_OS, + tttext->lpszText); } #if 0 tttext->uFlags |= TTF_DI_SETITEM; @@ -2115,6 +2140,7 @@ mswindows_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) case WM_COMMAND: { WORD id = LOWORD (wParam); + WORD nid = HIWORD (wParam); HWND cid = (HWND)lParam; frame = XFRAME (mswindows_find_frame (hwnd)); @@ -2122,17 +2148,86 @@ mswindows_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) if (!NILP (mswindows_handle_toolbar_wm_command (frame, cid, id))) break; #endif - + /* widgets in a buffer only eval a callback for suitable events.*/ + switch (nid) + { + case BN_CLICKED: + case EN_CHANGE: + case CBN_EDITCHANGE: + case CBN_SELCHANGE: + if (!NILP (mswindows_handle_gui_wm_command (frame, cid, id))) + return 0; + default: /* do nothing */ + } + /* menubars always must come last since the hashtables do not + always exist*/ #ifdef HAVE_MENUBARS if (!NILP (mswindows_handle_wm_command (frame, id))) break; #endif - /* Bite me - a spurious command. This cannot happen. */ - error ("XEMACS BUG: Cannot decode command message"); + return DefWindowProc (hwnd, message, wParam, lParam); + /* Bite me - a spurious command. This used to not be able to + happen but with the introduction of widgets its now + possible. */ } break; + case WM_CTLCOLORBTN: + case WM_CTLCOLORLISTBOX: + case WM_CTLCOLOREDIT: + case WM_CTLCOLORSTATIC: + case WM_CTLCOLORSCROLLBAR: + { + /* if we get an opportunity to paint a widget then do so if + there is an appropriate face */ + HWND crtlwnd = (HWND)lParam; + LONG ii = GetWindowLong (crtlwnd, GWL_USERDATA); + if (ii) + { + Lisp_Object image_instance; + VOID_TO_LISP (image_instance, ii); + if (IMAGE_INSTANCEP (image_instance) + && + IMAGE_INSTANCE_TYPE_P (image_instance, IMAGE_WIDGET) + && + !NILP (XIMAGE_INSTANCE_WIDGET_FACE (image_instance))) + { + /* set colors for the buttons */ + HDC hdc = (HDC)wParam; + if (last_widget_brushed != ii) + { + if (widget_brush) + DeleteObject (widget_brush); + widget_brush = CreateSolidBrush + (COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_BACKGROUND + (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), + XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); + } + last_widget_brushed = ii; + SetTextColor + (hdc, + COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_FOREGROUND + (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), + XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); + SetBkMode (hdc, OPAQUE); + SetBkColor + (hdc, + COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_BACKGROUND + (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), + XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); + return (LRESULT)widget_brush; + } + } + } + goto defproc; + #ifdef HAVE_DRAGNDROP case WM_DROPFILES: /* implementation ripped-off from event-Xt.c */ { @@ -2518,6 +2613,7 @@ emacs_mswindows_handle_magic_event (struct Lisp_Event *emacs_event) } } +#ifndef HAVE_MSG_SELECT static HANDLE get_process_input_waitable (struct Lisp_Process *process) { @@ -2567,6 +2663,7 @@ emacs_mswindows_unselect_process (struct Lisp_Process *process) HANDLE hev = get_process_input_waitable (process); remove_waitable_handle (hev); } +#endif /* HAVE_MSG_SELECT */ static void emacs_mswindows_select_console (struct console *con) @@ -2581,14 +2678,20 @@ emacs_mswindows_unselect_console (struct console *con) static void emacs_mswindows_quit_p (void) { + MSG msg; + /* Quit cannot happen in modal loop: all program input is dedicated to Windows. */ if (mswindows_in_modal_loop) return; - /* Drain windows queue. This sets up number of quit - characters in in the queue */ - mswindows_drain_windows_queue (); + /* Drain windows queue. This sets up number of quit characters in the queue + * (and also processes wm focus change, move, resize, etc messages). + * We don't want to process WM_PAINT messages because this function can be + * called from almost anywhere and the windows' states may be changing. */ + while (PeekMessage (&msg, NULL, 0, WM_PAINT-1, PM_REMOVE) || + PeekMessage (&msg, NULL, WM_PAINT+1, WM_USER-1, PM_REMOVE)) + DispatchMessage (&msg); if (mswindows_quit_chars_count > 0) { diff --git a/src/events.c b/src/events.c index 6fe8e6e..143782f 100644 --- a/src/events.c +++ b/src/events.c @@ -179,7 +179,7 @@ print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) assert (INTP (Vx)); Vy = Fevent_y_pixel (obj); assert (INTP (Vy)); - sprintf (buf, "#event_type != (t1)) \ - e = wrong_type_argument ((sym),(e)); \ + e = wrong_type_argument (sym,e); \ } while (0) -#define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \ - CHECK_LIVE_EVENT (e); \ - if (XEVENT(e)->event_type != (t1) && \ - XEVENT(e)->event_type != (t2)) \ - e = wrong_type_argument ((sym),(e)); \ +#define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \ + CHECK_LIVE_EVENT (e); \ + { \ + emacs_event_type CET_type = XEVENT (e)->event_type; \ + if (CET_type != (t1) && \ + CET_type != (t2)) \ + e = wrong_type_argument (sym,e); \ + } \ } while (0) -#define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \ - CHECK_LIVE_EVENT (e); \ - if (XEVENT(e)->event_type != (t1) && \ - XEVENT(e)->event_type != (t2) && \ - XEVENT(e)->event_type != (t3)) \ - e = wrong_type_argument ((sym),(e)); \ +#define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \ + CHECK_LIVE_EVENT (e); \ + { \ + emacs_event_type CET_type = XEVENT (e)->event_type; \ + if (CET_type != (t1) && \ + CET_type != (t2) && \ + CET_type != (t3)) \ + e = wrong_type_argument (sym,e); \ + } \ } while (0) DEFUN ("event-key", Fevent_key, 1, 1, 0, /* diff --git a/src/faces.c b/src/faces.c index 3ec7039..44fbd98 100644 --- a/src/faces.c +++ b/src/faces.c @@ -55,7 +55,7 @@ Lisp_Object Qinit_global_faces; calling Ffind_face. */ Lisp_Object Vdefault_face, Vmodeline_face, Vgui_element_face; Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face; -Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face; +Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face, Vwidget_face; /* Qdefault, Qhighlight defined in general.c */ Lisp_Object Qmodeline, Qgui_element, Qleft_margin, Qright_margin, Qtext_cursor; @@ -1736,7 +1736,7 @@ LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'. void syms_of_faces (void) { - /* Qdefault defined in general.c */ + /* Qdefault & Qwidget defined in general.c */ defsymbol (&Qmodeline, "modeline"); defsymbol (&Qgui_element, "gui-element"); defsymbol (&Qleft_margin, "left-margin"); @@ -1793,6 +1793,8 @@ vars_of_faces (void) Vdefault_face = Qnil; staticpro (&Vgui_element_face); Vgui_element_face = Qnil; + staticpro (&Vwidget_face); + Vwidget_face = Qnil; staticpro (&Vmodeline_face); Vmodeline_face = Qnil; staticpro (&Vtoolbar_face); @@ -1998,6 +2000,18 @@ complex_vars_of_faces (void) Fget (Vgui_element_face, Qbackground_pixmap, Qunbound)); + /* widget is another gui element */ + Vwidget_face = Fmake_face (Qwidget, + build_string ("widget face"), + Qnil); + set_specifier_fallback (Fget (Vwidget_face, Qforeground, Qunbound), + Fget (Vgui_element_face, Qforeground, Qunbound)); + set_specifier_fallback (Fget (Vwidget_face, Qbackground, Qunbound), + Fget (Vgui_element_face, Qbackground, Qunbound)); + set_specifier_fallback (Fget (Vwidget_face, Qbackground_pixmap, Qnil), + Fget (Vgui_element_face, Qbackground_pixmap, + Qunbound)); + Vleft_margin_face = Fmake_face (Qleft_margin, build_string ("left margin face"), Qnil); diff --git a/src/faces.h b/src/faces.h index d57e8ee..c2e821d 100644 --- a/src/faces.h +++ b/src/faces.h @@ -260,8 +260,8 @@ EXFUN (Fget_face, 1); extern Lisp_Object Qstrikethru, Vbuilt_in_face_specifiers, Vdefault_face; extern Lisp_Object Vleft_margin_face, Vpointer_face, Vright_margin_face; -extern Lisp_Object Vtext_cursor_face, Vvertical_divider_face; -extern Lisp_Object Vtoolbar_face, Vgui_element_face; +extern Lisp_Object Vtext_cursor_face, Vvertical_divider_face; +extern Lisp_Object Vtoolbar_face, Vgui_element_face, Vwidget_face; void mark_all_faces_as_clean (void); void init_frame_faces (struct frame *f); diff --git a/src/fns.c b/src/fns.c index 269ae5e..c9d19f6 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3037,7 +3037,9 @@ changing the value of `foo'. while (argnum < nargs) { - Lisp_Object val = args[argnum]; + Lisp_Object val; + retry: + val = args[argnum]; if (CONSP (val)) { /* `val' is the first cons, which will be our return value. */ @@ -3048,7 +3050,7 @@ changing the value of `foo'. for (argnum++; argnum < nargs; argnum++) { Lisp_Object next = args[argnum]; - retry: + retry_next: if (CONSP (next) || argnum == nargs -1) { /* (setcdr (last val) next) */ @@ -3073,8 +3075,8 @@ changing the value of `foo'. } else { - next = wrong_type_argument (next, Qlistp); - goto retry; + next = wrong_type_argument (Qlistp, next); + goto retry_next; } } RETURN_UNGCPRO (val); @@ -3084,86 +3086,84 @@ changing the value of `foo'. else if (argnum == nargs - 1) /* last arg? */ RETURN_UNGCPRO (val); else - args[argnum] = wrong_type_argument (val, Qlistp); + { + args[argnum] = wrong_type_argument (Qlistp, val); + goto retry; + } } RETURN_UNGCPRO (Qnil); /* No non-nil args provided. */ } /* This is the guts of all mapping functions. - Apply fn to each element of seq, one by one, - storing the results into elements of vals, a C vector of Lisp_Objects. - leni is the length of vals, which should also be the length of seq. + Apply fn to each element of seq, one by one, + storing the results into elements of vals, a C vector of Lisp_Objects. + leni is the length of vals, which should also be the length of seq. - If VALS is a null pointer, do not accumulate the results. */ + If VALS is a null pointer, do not accumulate the results. */ static void -mapcar1 (int leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) +mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { - Lisp_Object tail; - Lisp_Object dummy = Qnil; - int i; - struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object result; - - GCPRO3 (dummy, fn, seq); + Lisp_Object args[2]; + int i; + struct gcpro gcpro1; if (vals) { - /* Don't let vals contain any garbage when GC happens. */ - for (i = 0; i < leni; i++) - vals[i] = Qnil; - gcpro1.var = vals; - gcpro1.nvars = leni; + GCPRO1 (vals[0]); + gcpro1.nvars = 0; } - /* We need not explicitly protect `tail' because it is used only on - lists, and 1) lists are not relocated and 2) the list is marked - via `seq' so will not be freed */ + args[0] = fn; - if (VECTORP (seq)) + if (LISTP (seq)) { for (i = 0; i < leni; i++) { - dummy = XVECTOR_DATA (seq)[i]; - result = call1 (fn, dummy); - if (vals) - vals[i] = result; + args[1] = XCAR (seq); + seq = XCDR (seq); + result = Ffuncall (2, args); + if (vals) vals[gcpro1.nvars++] = result; } } - else if (BIT_VECTORP (seq)) + else if (VECTORP (seq)) { - struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq); + Lisp_Object *objs = XVECTOR_DATA (seq); for (i = 0; i < leni; i++) { - XSETINT (dummy, bit_vector_bit (v, i)); - result = call1 (fn, dummy); - if (vals) - vals[i] = result; + args[1] = *objs++; + result = Ffuncall (2, args); + if (vals) vals[gcpro1.nvars++] = result; } } else if (STRINGP (seq)) { + Bufbyte *p = XSTRING_DATA (seq); for (i = 0; i < leni; i++) { - result = call1 (fn, make_char (string_char (XSTRING (seq), i))); - if (vals) - vals[i] = result; + args[1] = make_char (charptr_emchar (p)); + INC_CHARPTR (p); + result = Ffuncall (2, args); + if (vals) vals[gcpro1.nvars++] = result; } } - else /* Must be a list, since Flength did not get an error */ + else if (BIT_VECTORP (seq)) { - tail = seq; + struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq); for (i = 0; i < leni; i++) { - result = call1 (fn, Fcar (tail)); - if (vals) - vals[i] = result; - tail = Fcdr (tail); + args[1] = make_int (bit_vector_bit (v, i)); + result = Ffuncall (2, args); + if (vals) vals[gcpro1.nvars++] = result; } } + else + abort(); /* cannot get here since Flength(seq) did not get an error */ - UNGCPRO; + if (vals) + UNGCPRO; } DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /* @@ -3173,7 +3173,7 @@ Thus, " " as SEP results in spaces between the values returned by FN. */ (fn, seq, sep)) { - int len = XINT (Flength (seq)); + size_t len = XINT (Flength (seq)); Lisp_Object *args; int i; struct gcpro gcpro1; @@ -3203,7 +3203,7 @@ SEQUENCE may be a list, a vector, a bit vector, or a string. */ (fn, seq)) { - int len = XINT (Flength (seq)); + size_t len = XINT (Flength (seq)); Lisp_Object *args = alloca_array (Lisp_Object, len); mapcar1 (len, args, fn, seq); @@ -3218,9 +3218,7 @@ SEQUENCE may be a list, a vector or a string. */ (fn, seq)) { - int len = XINT (Flength (seq)); - /* Ideally, this should call make_vector_internal, because we don't - need initialization. */ + size_t len = XINT (Flength (seq)); Lisp_Object result = make_vector (len, Qnil); struct gcpro gcpro1; diff --git a/src/frame-msw.c b/src/frame-msw.c index 3325da7..e7c19a0 100644 --- a/src/frame-msw.c +++ b/src/frame-msw.c @@ -33,6 +33,7 @@ Boston, MA 02111-1307, USA. */ #include "lisp.h" #include "buffer.h" +#include "elhash.h" #include "console-msw.h" #include "glyphs-msw.h" #include "elhash.h" @@ -129,10 +130,12 @@ mswindows_init_frame_1 (struct frame *f, Lisp_Object props) FRAME_MSWINDOWS_DATA(f)->sizing = 0; FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil; #ifdef HAVE_TOOLBARS - FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) = + FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) = make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); #endif - + /* hashtable of instantiated glyphs on the frame. */ + FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f) = + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); /* Will initialize these in WM_SIZE handler. We cannot do it now, because we do not know what is CW_USEDEFAULT height and width */ FRAME_WIDTH (f) = 0; @@ -249,6 +252,7 @@ mswindows_mark_frame (struct frame *f, void (*markobj) (Lisp_Object)) #ifdef HAVE_TOOLBARS markobj (FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f)); #endif + markobj (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); } static void @@ -394,6 +398,10 @@ mswindows_set_frame_pointer (struct frame *f) { SetClassLong (FRAME_MSWINDOWS_HANDLE (f), GCL_HCURSOR, (LONG) XIMAGE_INSTANCE_MSWINDOWS_ICON (f->pointer)); + /* we only have to do this because GC doesn't cause a mouse + event and doesn't give time to event processing even if it + did. */ + SetCursor (XIMAGE_INSTANCE_MSWINDOWS_ICON (f->pointer)); } } diff --git a/src/frame-x.c b/src/frame-x.c index 4011bdb..a5d62c6 100644 --- a/src/frame-x.c +++ b/src/frame-x.c @@ -2632,25 +2632,25 @@ x_delete_frame (struct frame *f) DtDndDropUnregister (FRAME_X_TEXT_WIDGET (f)); #endif /* HAVE_CDE */ - assert (FRAME_X_SHELL_WIDGET (f)); - if (FRAME_X_SHELL_WIDGET (f)) - { - Display *dpy = XtDisplay (FRAME_X_SHELL_WIDGET (f)); - expect_x_error (dpy); - /* for obscure reasons having (I think) to do with the internal - window-to-widget hierarchy maintained by Xt, we have to call - XtUnrealizeWidget() here. Xt can really suck. */ - if (f->being_deleted) - XtUnrealizeWidget (FRAME_X_SHELL_WIDGET (f)); - XtDestroyWidget (FRAME_X_SHELL_WIDGET (f)); - x_error_occurred_p (dpy); - - /* make sure the windows are really gone! */ - /* ### Is this REALLY necessary? */ - XFlush (dpy); - - FRAME_X_SHELL_WIDGET (f) = 0; - } + assert (FRAME_X_SHELL_WIDGET (f) != 0); + +#ifdef EXTERNAL_WIDGET + expect_x_error (XtDisplay (FRAME_X_SHELL_WIDGET (f))); + /* for obscure reasons having (I think) to do with the internal + window-to-widget hierarchy maintained by Xt, we have to call + XtUnrealizeWidget() here. Xt can really suck. */ + if (f->being_deleted) + XtUnrealizeWidget (FRAME_X_SHELL_WIDGET (f)); + XtDestroyWidget (FRAME_X_SHELL_WIDGET (f)); + x_error_occurred_p (XtDisplay (FRAME_X_SHELL_WIDGET (f))); +#else + XtDestroyWidget (FRAME_X_SHELL_WIDGET (f)); + /* make sure the windows are really gone! */ + /* ### Is this REALLY necessary? */ + XFlush (XtDisplay (FRAME_X_SHELL_WIDGET (f))); +#endif /* EXTERNAL_WIDGET */ + + FRAME_X_SHELL_WIDGET (f) = 0; if (FRAME_X_GEOM_FREE_ME_PLEASE (f)) { diff --git a/src/frame.c b/src/frame.c index 38c8cc3..6c7fde4 100644 --- a/src/frame.c +++ b/src/frame.c @@ -128,6 +128,8 @@ mark_frame (Lisp_Object obj, void (*markobj) (Lisp_Object)) #define MARKED_SLOT(x) ((void) (markobj (f->x))); #include "frameslots.h" + mark_subwindow_cachels (f->subwindow_cachels, markobj); + if (FRAME_LIVE_P (f)) /* device is nil for a dead frame */ MAYBE_FRAMEMETH (f, mark_frame, (f, markobj)); @@ -203,6 +205,9 @@ allocate_frame_core (Lisp_Object device) f->selected_window = root_window; f->last_nonminibuf_window = root_window; + /* cache of subwindows visible on frame */ + f->subwindow_cachels = Dynarr_new (subwindow_cachel); + /* Choose a buffer for the frame's root window. */ XWINDOW (root_window)->buffer = Qt; { @@ -451,9 +456,9 @@ See `set-frame-properties', `default-x-frame-plist', and things. */ init_frame_toolbars (f); #endif - reset_face_cachels (XWINDOW (FRAME_SELECTED_WINDOW (f))); reset_glyph_cachels (XWINDOW (FRAME_SELECTED_WINDOW (f))); + reset_subwindow_cachels (f); change_frame_size (f, f->height, f->width, 0); } @@ -1531,6 +1536,13 @@ delete_frame_internal (struct frame *f, int force, delete_all_subwindows (XWINDOW (f->root_window)); f->root_window = Qnil; + /* clear out the cached glyph information */ + if (f->subwindow_cachels) + { + Dynarr_free (f->subwindow_cachels); + f->subwindow_cachels = 0; + } + /* Remove the frame now from the list. This way, any events generated on this frame by the maneuvers below will disperse themselves. */ diff --git a/src/frame.h b/src/frame.h index 17ac712..ff5b332 100644 --- a/src/frame.h +++ b/src/frame.h @@ -32,6 +32,7 @@ Boston, MA 02111-1307, USA. */ #endif #include "device.h" +#include "glyphs.h" #define FRAME_TYPE_NAME(f) ((f)->framemeths->name) #define FRAME_TYPE(f) ((f)->framemeths->symbol) @@ -89,6 +90,9 @@ struct frame int modiff; + /* subwindow cache elements for this frame */ + subwindow_cachel_dynarr *subwindow_cachels; + #ifdef HAVE_SCROLLBARS /* frame-local scrollbar information. See scrollbar.c. */ int scrollbar_y_offset; @@ -163,6 +167,7 @@ Value : Emacs meaning :f-v-p : X meaning unsigned int extents_changed :1; unsigned int faces_changed :1; unsigned int frame_changed :1; + unsigned int subwindows_changed :1; unsigned int glyphs_changed :1; unsigned int icon_changed :1; unsigned int menubar_changed :1; @@ -311,6 +316,19 @@ extern int frame_changed; glyphs_changed = 1; \ } while (0) +#define MARK_FRAME_SUBWINDOWS_CHANGED(f) do { \ + struct frame *mfgc_f = (f); \ + mfgc_f->subwindows_changed = 1; \ + mfgc_f->modiff++; \ + if (!NILP (mfgc_f->device)) \ + { \ + struct device *mfgc_d = XDEVICE (mfgc_f->device); \ + MARK_DEVICE_SUBWINDOWS_CHANGED (mfgc_d); \ + } \ + else \ + subwindows_changed = 1; \ +} while (0) + #define MARK_FRAME_TOOLBARS_CHANGED(f) do { \ struct frame *mftc_f = (f); \ mftc_f->toolbar_changed = 1; \ @@ -422,6 +440,11 @@ extern int frame_changed; #define FRAME_SCROLLBAR_HEIGHT(f) 0 #endif +#define FW_FRAME(obj) \ + (WINDOWP (obj) ? WINDOW_FRAME (XWINDOW (obj)) \ + : (FRAMEP (obj) ? obj \ + : Qnil)) + #define FRAME_NEW_HEIGHT(f) ((f)->new_height) #define FRAME_NEW_WIDTH(f) ((f)->new_width) #define FRAME_CURSOR_X(f) ((f)->cursor_x) @@ -439,6 +462,7 @@ extern int frame_changed; NON_LVALUE ((f)->last_nonminibuf_window) #define FRAME_SB_VCACHE(f) ((f)->sb_vcache) #define FRAME_SB_HCACHE(f) ((f)->sb_hcache) +#define FRAME_SUBWINDOW_CACHE(f) ((f)->subwindow_cachels) #if 0 /* FSFmacs */ diff --git a/src/free-hook.c b/src/free-hook.c index 07a5edd..af1df69 100644 --- a/src/free-hook.c +++ b/src/free-hook.c @@ -66,7 +66,7 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" #else -void *malloc (unsigned long); +void *malloc (size_t); #endif #if !defined(HAVE_LIBMCHECK) @@ -88,9 +88,9 @@ void *malloc (unsigned long); struct hash_table *pointer_table; extern void (*__free_hook) (void *); -extern void *(*__malloc_hook) (unsigned long); +extern void *(*__malloc_hook) (size_t); -static void *check_malloc (unsigned long); +static void *check_malloc (size_t); typedef void (*fun_ptr) (); @@ -212,9 +212,9 @@ check_free (void *ptr) } static void * -check_malloc (unsigned long size) +check_malloc (size_t size) { - unsigned long rounded_up_size; + size_t rounded_up_size; void *result; __free_hook = 0; @@ -240,7 +240,7 @@ check_malloc (unsigned long size) return result; } -extern void *(*__realloc_hook) (void *, unsigned long); +extern void *(*__realloc_hook) (void *, size_t); #ifdef MIN #undef MIN @@ -250,10 +250,10 @@ extern void *(*__realloc_hook) (void *, unsigned long); /* Don't optimize realloc */ static void * -check_realloc (void * ptr, unsigned long size) +check_realloc (void * ptr, size_t size) { EMACS_INT present; - unsigned long old_size; + size_t old_size; void *result = malloc (size); if (!ptr) return result; @@ -295,7 +295,7 @@ disable_strict_free_check (void) completely gone in XEmacs */ static void * -block_input_malloc (unsigned long size); +block_input_malloc (size_t size); static void block_input_free (void* ptr) @@ -308,7 +308,7 @@ block_input_free (void* ptr) } static void * -block_input_malloc (unsigned long size) +block_input_malloc (size_t size) { void* result; __free_hook = 0; @@ -321,7 +321,7 @@ block_input_malloc (unsigned long size) static void * -block_input_realloc (void* ptr, unsigned long size) +block_input_realloc (void* ptr, size_t size) { void* result; __free_hook = 0; @@ -406,9 +406,9 @@ syms_of_free_hook (void) } #else -void (*__free_hook)() = check_free; -void *(*__malloc_hook)() = check_malloc; -void *(*__realloc_hook)() = check_realloc; +void (*__free_hook)(void *) = check_free; +void *(*__malloc_hook)(size_t) = check_malloc; +void *(*__realloc_hook)(void *, size_t) = check_realloc; #endif #endif /* !defined(HAVE_LIBMCHECK) */ diff --git a/src/general.c b/src/general.c index 45f5a56..973d1e4 100644 --- a/src/general.c +++ b/src/general.c @@ -149,6 +149,7 @@ Lisp_Object Qreturn; Lisp_Object Qreverse; Lisp_Object Qright; Lisp_Object Qsearch; +Lisp_Object Qselected; Lisp_Object Qsignal; Lisp_Object Qsimple; Lisp_Object Qsize; @@ -177,6 +178,7 @@ Lisp_Object Qvector; Lisp_Object Qwarning; Lisp_Object Qwhite; Lisp_Object Qwidth; +Lisp_Object Qwidget; Lisp_Object Qwindow; Lisp_Object Qwindow_system; Lisp_Object Qx; @@ -303,6 +305,7 @@ syms_of_general (void) defsymbol (&Qreverse, "reverse"); defsymbol (&Qright, "right"); defsymbol (&Qsearch, "search"); + defsymbol (&Qselected, "selected"); defsymbol (&Qsignal, "signal"); defsymbol (&Qsimple, "simple"); defsymbol (&Qsize, "size"); @@ -331,6 +334,7 @@ syms_of_general (void) defsymbol (&Qwarning, "warning"); defsymbol (&Qwhite, "white"); defsymbol (&Qwidth, "width"); + defsymbol (&Qwidget, "widget"); defsymbol (&Qwindow, "window"); defsymbol (&Qwindow_system, "window-system"); defsymbol (&Qx, "x"); diff --git a/src/glyphs-msw.c b/src/glyphs-msw.c index 34e4130..f95c1e8 100644 --- a/src/glyphs-msw.c +++ b/src/glyphs-msw.c @@ -1,4 +1,4 @@ -/* mswindows-specific Lisp objects. +/* mswindows-specific glyph objects. Copyright (C) 1998 Andy Piper. This file is part of XEmacs. @@ -20,7 +20,7 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ -/* written by Andy Piper plagerising buts from +/* written by Andy Piper plagerising bits from glyphs-x.c */ #include @@ -32,6 +32,8 @@ Boston, MA 02111-1307, USA. */ #include "glyphs-msw.h" #include "objects-msw.h" +#include "window.h" +#include "elhash.h" #include "buffer.h" #include "frame.h" #include "insdel.h" @@ -46,6 +48,22 @@ Boston, MA 02111-1307, USA. */ #include #include +#define WIDGET_GLYPH_SLOT 0 + +#ifdef HAVE_XPM +DEFINE_DEVICE_IIFORMAT (mswindows, xpm); +#endif +DEFINE_DEVICE_IIFORMAT (mswindows, xbm); +DEFINE_DEVICE_IIFORMAT (mswindows, button); +DEFINE_DEVICE_IIFORMAT (mswindows, edit); +#if 0 +DEFINE_DEVICE_IIFORMAT (mswindows, group); +#endif +DEFINE_DEVICE_IIFORMAT (mswindows, subwindow); +DEFINE_DEVICE_IIFORMAT (mswindows, widget); +DEFINE_DEVICE_IIFORMAT (mswindows, label); +DEFINE_DEVICE_IIFORMAT (mswindows, scrollbar); +DEFINE_DEVICE_IIFORMAT (mswindows, combo); DEFINE_IMAGE_INSTANTIATOR_FORMAT (bmp); Lisp_Object Qbmp; @@ -58,7 +76,7 @@ Lisp_Object Qmswindows_resource; static void mswindows_initialize_dibitmap_image_instance (struct Lisp_Image_Instance *ii, - enum image_instance_type type); + enum image_instance_type type); static void mswindows_initialize_image_instance_mask (struct Lisp_Image_Instance* image, struct frame* f); @@ -660,7 +678,7 @@ extract_xpm_color_names (Lisp_Object device, colortbl[j].color = COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (XCDR (cons))); - colortbl[j].name = (char *) XSTRING_DATA (XCAR (cons)); + GET_C_STRING_OS_DATA_ALLOCA (XCAR (cons), colortbl[j].name); free_cons (XCONS (cons)); cons = results; results = XCDR (results); @@ -1093,7 +1111,9 @@ static int resource_name_to_resource (Lisp_Object name, int type) } do { - if (!strcasecmp ((char*)res->name, XSTRING_DATA (name))) + Extbyte* nm=0; + GET_C_STRING_OS_DATA_ALLOCA (name, nm); + if (!strcasecmp ((char*)res->name, nm)) return res->resource_id; } while ((++res)->name); return 0; @@ -1151,11 +1171,13 @@ mswindows_resource_instantiate (Lisp_Object image_instance, Lisp_Object instanti /* mess with the keyword info we were provided with */ if (!NILP (file)) { + Extbyte* f=0; + GET_C_STRING_FILENAME_DATA_ALLOCA (file, f); #ifdef __CYGWIN32__ - CYGWIN_WIN32_PATH (XSTRING_DATA (file), fname); + CYGWIN_WIN32_PATH (f, fname); #else /* #### FIXME someone who knows ... */ - fname = XSTRING_DATA (file); + fname = f #endif if (NILP (resource_id)) @@ -1168,7 +1190,7 @@ mswindows_resource_instantiate (Lisp_Object image_instance, Lisp_Object instanti type)); if (!resid) - resid = XSTRING_DATA (resource_id); + GET_C_STRING_OS_DATA_ALLOCA (resource_id, resid); } } else if (!(resid = MAKEINTRESOURCE (resource_name_to_resource (resource_id, @@ -1839,6 +1861,7 @@ mswindows_print_image_instance (struct Lisp_Image_Instance *p, } write_c_string (")", printcharfun); break; + default: break; } @@ -1847,24 +1870,140 @@ mswindows_print_image_instance (struct Lisp_Image_Instance *p, static void mswindows_finalize_image_instance (struct Lisp_Image_Instance *p) { - if (!p->data) - return; - if (DEVICE_LIVE_P (XDEVICE (p->device))) { - if (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)) - DeleteObject (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)); - IMAGE_INSTANCE_MSWINDOWS_BITMAP (p) = 0; - if (IMAGE_INSTANCE_MSWINDOWS_MASK (p)) - DeleteObject (IMAGE_INSTANCE_MSWINDOWS_MASK (p)); - IMAGE_INSTANCE_MSWINDOWS_MASK (p) = 0; - if (IMAGE_INSTANCE_MSWINDOWS_ICON (p)) - DestroyIcon (IMAGE_INSTANCE_MSWINDOWS_ICON (p)); - IMAGE_INSTANCE_MSWINDOWS_ICON (p) = 0; + if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET + || + IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) + { + if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) + DestroyWindow (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p)); + IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0; + } + else if (p->data) + { + if (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)) + DeleteObject (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)); + IMAGE_INSTANCE_MSWINDOWS_BITMAP (p) = 0; + if (IMAGE_INSTANCE_MSWINDOWS_MASK (p)) + DeleteObject (IMAGE_INSTANCE_MSWINDOWS_MASK (p)); + IMAGE_INSTANCE_MSWINDOWS_MASK (p) = 0; + if (IMAGE_INSTANCE_MSWINDOWS_ICON (p)) + DestroyIcon (IMAGE_INSTANCE_MSWINDOWS_ICON (p)); + IMAGE_INSTANCE_MSWINDOWS_ICON (p) = 0; + } + } + + if (p->data) + { + xfree (p->data); + p->data = 0; } +} + +/************************************************************************/ +/* subwindow and widget support */ +/************************************************************************/ + +/* unmap the image if it is a widget. This is used by redisplay via + redisplay_unmap_subwindows */ +static void +mswindows_unmap_subwindow (struct Lisp_Image_Instance *p) +{ + if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) + { + SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), + NULL, + 0, 0, 0, 0, + SWP_HIDEWINDOW | SWP_NOMOVE | SWP_NOSIZE + | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); + } +} + +/* map the subwindow. This is used by redisplay via + redisplay_output_subwindow */ +static void +mswindows_map_subwindow (struct Lisp_Image_Instance *p, int x, int y) +{ + /* ShowWindow (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), SW_SHOW);*/ + SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), + NULL, + x, y, 0, 0, + SWP_NOZORDER | SWP_SHOWWINDOW | SWP_NOSIZE + | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); +} + +/* when you click on a widget you may activate another widget this + needs to be checked and all appropriate widgets updated */ +static void +mswindows_update_subwindow (struct Lisp_Image_Instance *p) +{ + if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET) + { + /* buttons checked or otherwise */ + if ( EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qbutton)) + { + if (gui_item_selected_p (&IMAGE_INSTANCE_WIDGET_ITEM (p))) + SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), + BM_SETCHECK, (WPARAM)BST_CHECKED, 0); + else + SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), + BM_SETCHECK, (WPARAM)BST_UNCHECKED, 0); + } + } +} + +/* register widgets into our hastable so that we can cope with the + callbacks. The hashtable is weak so deregistration is handled + automatically */ +static int +mswindows_register_widget_instance (Lisp_Object instance, Lisp_Object domain) +{ + Lisp_Object frame = FW_FRAME (domain); + struct frame* f = XFRAME (frame); + int id = gui_item_hash (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), + &XIMAGE_INSTANCE_WIDGET_ITEM (instance), + WIDGET_GLYPH_SLOT); + Fputhash (make_int (id), + XIMAGE_INSTANCE_WIDGET_CALLBACK (instance), + FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); + return id; +} + +static void +mswindows_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + 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); + struct device* d = XDEVICE (device); + Lisp_Object frame = FW_FRAME (domain); + HWND wnd; + + if (!DEVICE_MSWINDOWS_P (d)) + signal_simple_error ("Not an mswindows device", device); - xfree (p->data); - p->data = 0; + /* have to set the type this late in case there is no device + instantiation for a widget */ + IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW; + + wnd = CreateWindow( "STATIC", + "", + WS_CHILD, + 0, /* starting x position */ + 0, /* starting y position */ + IMAGE_INSTANCE_WIDGET_WIDTH (ii), + IMAGE_INSTANCE_WIDGET_HEIGHT (ii), + FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), /* parent window */ + 0, + (HINSTANCE) + GetWindowLong (FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), + GWL_HINSTANCE), + NULL); + + SetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance)); + IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd; } static int @@ -1880,6 +2019,7 @@ mswindows_image_instance_equal (struct Lisp_Image_Instance *p1, != IMAGE_INSTANCE_MSWINDOWS_BITMAP (p2)) return 0; break; + default: break; } @@ -1896,6 +2036,7 @@ mswindows_image_instance_hash (struct Lisp_Image_Instance *p, int depth) case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: return (unsigned long) IMAGE_INSTANCE_MSWINDOWS_BITMAP (p); + default: return 0; } @@ -1909,7 +2050,7 @@ mswindows_image_instance_hash (struct Lisp_Image_Instance *p, int depth) static void mswindows_initialize_dibitmap_image_instance (struct Lisp_Image_Instance *ii, - enum image_instance_type type) + enum image_instance_type type) { ii->data = xnew_and_zero (struct mswindows_image_instance_data); IMAGE_INSTANCE_TYPE (ii) = type; @@ -1923,6 +2064,292 @@ mswindows_initialize_dibitmap_image_instance (struct Lisp_Image_Instance *ii, /************************************************************************/ +/* widgets */ +/************************************************************************/ + +static void +mswindows_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain, + CONST char* class, int flags, int exflags) +{ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); +#if 0 + struct Lisp_Image_Instance *groupii = 0; + Lisp_Object group = find_keyword_in_vector (instantiator, Q_group); +#endif + Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), style; + struct device* d = XDEVICE (device); + Lisp_Object frame = FW_FRAME (domain); + Extbyte* nm=0; + HWND wnd; + int id = 0xffff; + struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii); + + if (!DEVICE_MSWINDOWS_P (d)) + signal_simple_error ("Not an mswindows device", device); +#if 0 + /* if the user specified another glyph as a group pick up the + instance in our domain. */ + if (!NILP (group)) + { + if (SYMBOLP (group)) + group = XSYMBOL (group)->value; + group = glyph_image_instance (group, domain, ERROR_ME, 1); + groupii = XIMAGE_INSTANCE (group); + } +#endif + if (!gui_item_active_p (pgui)) + flags |= WS_DISABLED; + + style = pgui->style; + + if (!NILP (pgui->callback)) + { + id = mswindows_register_widget_instance (image_instance, domain); + } + /* have to set the type this late in case there is no device + instantiation for a widget */ + IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET; + if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) + GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm); + + wnd = CreateWindowEx( + exflags /* | WS_EX_NOPARENTNOTIFY*/, + class, + nm, + flags | WS_CHILD, + 0, /* starting x position */ + 0, /* starting y position */ + IMAGE_INSTANCE_WIDGET_WIDTH (ii), + IMAGE_INSTANCE_WIDGET_HEIGHT (ii), + /* parent window */ + FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), + (HMENU)id, /* No menu */ + (HINSTANCE) + GetWindowLong (FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), + GWL_HINSTANCE), + NULL); + + IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd; + SetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance)); + /* set the widget font from the widget face */ + SendMessage (wnd, WM_SETFONT, + (WPARAM)FONT_INSTANCE_MSWINDOWS_HFONT + (XFONT_INSTANCE (widget_face_font_info + (domain, + IMAGE_INSTANCE_WIDGET_FACE (ii), + 0, 0))), + MAKELPARAM (TRUE, 0)); +} + +/* Instantiate a button widget. Unfortunately instantiated widgets are + particular to a frame since they need to have a parent. It's not + like images where you just select the image into the context you + want to display it in and BitBlt it. So images instances can have a + many-to-one relationship with things you see, whereas widgets can + only be one-to-one (i.e. per frame) */ +static void +mswindows_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + HWND wnd; + int flags = BS_NOTIFY; + Lisp_Object style; + struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii); + + if (!gui_item_active_p (pgui)) + flags |= WS_DISABLED; + + style = pgui->style; + + if (EQ (style, Qradio)) + { + flags |= BS_RADIOBUTTON; + } + else if (EQ (style, Qtoggle)) + { + flags |= BS_AUTOCHECKBOX; + } + else + flags |= BS_DEFPUSHBUTTON; + + mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "BUTTON", flags, + WS_EX_CONTROLPARENT); + + wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + /* set the checked state */ + if (gui_item_selected_p (pgui)) + SendMessage (wnd, BM_SETCHECK, (WPARAM)BST_CHECKED, 0); + else + SendMessage (wnd, BM_SETCHECK, (WPARAM)BST_UNCHECKED, 0); +} + +/* instantiate an edit control */ +static void +mswindows_edit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "EDIT", + ES_LEFT | ES_AUTOHSCROLL | WS_TABSTOP + | WS_BORDER, + WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT); +} + +/* instantiate a static control possible for putting other things in */ +static void +mswindows_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "STATIC", + 0, WS_EX_STATICEDGE); +} + +#if 0 +/* instantiate a static control possible for putting other things in */ +static void +mswindows_group_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "BUTTON", + WS_GROUP | BS_GROUPBOX | WS_BORDER, + WS_EX_CLIENTEDGE ); +} +#endif + +/* instantiate a scrollbar control */ +static void +mswindows_scrollbar_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "SCROLLBAR", + 0, + WS_EX_CLIENTEDGE ); +} + +/* instantiate a combo control */ +static void +mswindows_combo_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + HANDLE wnd; + Lisp_Object rest; + + /* Maybe ought to generalise this more but it may be very windows + specific. In windows the window height of a combo box is the + height when the combo box is open. Thus we need to set the height + before creating the window and then reset it to a single line + after the window is created so that redisplay does the right + thing. */ + mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "COMBOBOX", + WS_BORDER | WS_TABSTOP | CBS_DROPDOWN + | CBS_AUTOHSCROLL + | CBS_HASSTRINGS | WS_VSCROLL, + WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT); + /* reset the height */ + widget_text_to_pixel_conversion (domain, + IMAGE_INSTANCE_WIDGET_FACE (ii), 1, 0, + &IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii), 0); + wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + /* add items to the combo box */ + SendMessage (wnd, CB_RESETCONTENT, 0, 0); + LIST_LOOP (rest, Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), Q_items, Qnil)) + { + Extbyte* lparam; + GET_C_STRING_OS_DATA_ALLOCA (XCAR (rest), lparam); + if (SendMessage (wnd, CB_ADDSTRING, 0, (LPARAM)lparam) == CB_ERR) + signal_simple_error ("error adding combo entries", instantiator); + } +} + +/* get properties of a control */ +static Lisp_Object +mswindows_widget_property (Lisp_Object image_instance, Lisp_Object prop) +{ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + /* get the text from a control */ + if (EQ (prop, Qtext)) + { + Extcount len = SendMessage (wnd, WM_GETTEXTLENGTH, 0, 0); + Extbyte* buf =alloca (len+1); + + SendMessage (wnd, WM_GETTEXT, (WPARAM)len+1, (LPARAM) buf); + return build_ext_string (buf, FORMAT_OS); + } + return Qunbound; +} + +/* get properties of a button */ +static Lisp_Object +mswindows_button_property (Lisp_Object image_instance, Lisp_Object prop) +{ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + /* check the state of a button */ + if (EQ (prop, Qselected)) + { + if (SendMessage (wnd, BM_GETSTATE, 0, 0) & BST_CHECKED) + return Qt; + else + return Qnil; + } + return Qunbound; +} + +/* get properties of a combo box */ +static Lisp_Object +mswindows_combo_property (Lisp_Object image_instance, Lisp_Object prop) +{ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + /* get the text from a control */ + if (EQ (prop, Qtext)) + { + long item = SendMessage (wnd, CB_GETCURSEL, 0, 0); + Extcount len = SendMessage (wnd, CB_GETLBTEXTLEN, (WPARAM)item, 0); + Extbyte* buf = alloca (len+1); + SendMessage (wnd, CB_GETLBTEXT, (WPARAM)item, (LPARAM)buf); + return build_ext_string (buf, FORMAT_OS); + } + return Qunbound; +} + +/* set the properties of a control */ +static Lisp_Object +mswindows_widget_set_property (Lisp_Object image_instance, Lisp_Object prop, + Lisp_Object val) +{ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + if (EQ (prop, Qtext)) + { + Extbyte* lparam=0; + CHECK_STRING (val); + GET_C_STRING_OS_DATA_ALLOCA (val, lparam); + SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), + WM_SETTEXT, 0, (LPARAM)lparam); + return Qt; + } + return Qunbound; +} + + +/************************************************************************/ /* initialization */ /************************************************************************/ @@ -1940,20 +2367,52 @@ console_type_create_glyphs_mswindows (void) CONSOLE_HAS_METHOD (mswindows, print_image_instance); CONSOLE_HAS_METHOD (mswindows, finalize_image_instance); + CONSOLE_HAS_METHOD (mswindows, unmap_subwindow); + CONSOLE_HAS_METHOD (mswindows, map_subwindow); + CONSOLE_HAS_METHOD (mswindows, update_subwindow); CONSOLE_HAS_METHOD (mswindows, image_instance_equal); CONSOLE_HAS_METHOD (mswindows, image_instance_hash); CONSOLE_HAS_METHOD (mswindows, init_image_instance_from_eimage); CONSOLE_HAS_METHOD (mswindows, locate_pixmap_file); -#ifdef HAVE_XPM - CONSOLE_HAS_METHOD (mswindows, xpm_instantiate); -#endif - CONSOLE_HAS_METHOD (mswindows, xbm_instantiate); } void image_instantiator_format_create_glyphs_mswindows (void) { /* image-instantiator types */ +#ifdef HAVE_XPM + INITIALIZE_DEVICE_IIFORMAT (mswindows, xpm); + IIFORMAT_HAS_DEVMETHOD (mswindows, xpm, instantiate); +#endif + INITIALIZE_DEVICE_IIFORMAT (mswindows, xbm); + IIFORMAT_HAS_DEVMETHOD (mswindows, xbm, instantiate); + + INITIALIZE_DEVICE_IIFORMAT (mswindows, button); + IIFORMAT_HAS_DEVMETHOD (mswindows, button, property); + IIFORMAT_HAS_DEVMETHOD (mswindows, button, instantiate); + + INITIALIZE_DEVICE_IIFORMAT (mswindows, edit); + IIFORMAT_HAS_DEVMETHOD (mswindows, edit, instantiate); + + INITIALIZE_DEVICE_IIFORMAT (mswindows, subwindow); + IIFORMAT_HAS_DEVMETHOD (mswindows, subwindow, instantiate); + + INITIALIZE_DEVICE_IIFORMAT (mswindows, widget); + IIFORMAT_HAS_DEVMETHOD (mswindows, widget, property); + IIFORMAT_HAS_DEVMETHOD (mswindows, widget, set_property); +#if 0 + INITIALIZE_DEVICE_IIFORMAT (mswindows, group); + IIFORMAT_HAS_DEVMETHOD (mswindows, group, instantiate); +#endif + INITIALIZE_DEVICE_IIFORMAT (mswindows, label); + IIFORMAT_HAS_DEVMETHOD (mswindows, label, instantiate); + + INITIALIZE_DEVICE_IIFORMAT (mswindows, combo); + IIFORMAT_HAS_DEVMETHOD (mswindows, combo, property); + IIFORMAT_HAS_DEVMETHOD (mswindows, combo, instantiate); + + INITIALIZE_DEVICE_IIFORMAT (mswindows, scrollbar); + IIFORMAT_HAS_DEVMETHOD (mswindows, scrollbar, instantiate); INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (bmp, "bmp"); @@ -1989,6 +2448,12 @@ A list of the directories in which mswindows bitmap files may be found. This is used by the `make-image-instance' function. */ ); Vmswindows_bitmap_file_path = Qnil; + + Fprovide (Qbutton); + Fprovide (Qedit); + Fprovide (Qcombo); + Fprovide (Qscrollbar); + Fprovide (Qlabel); } void diff --git a/src/glyphs-msw.h b/src/glyphs-msw.h index 9c304a0..8371d0a 100644 --- a/src/glyphs-msw.h +++ b/src/glyphs-msw.h @@ -1,8 +1,5 @@ /* mswindows-specific glyphs and related. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing - Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 1998 Andy Piper This file is part of XEmacs. @@ -75,5 +72,11 @@ void mswindows_initialize_image_instance_icon (struct Lisp_Image_Instance* image, int cursor); +#define WIDGET_INSTANCE_MSWINDOWS_HANDLE(i) \ + (HWND) (IMAGE_INSTANCE_SUBWINDOW_ID (i)) + +#define XWIDGET_INSTANCE_MSWINDOWS_HANDLE(i) \ + WIDGET_INSTANCE_MSWINDOWS_HANDLE (XIMAGE_INSTANCE (i)) + #endif /* HAVE_MS_WINDOWS */ #endif /* _XEMACS_GLYPHS_MSW_H_ */ diff --git a/src/glyphs-widget.c b/src/glyphs-widget.c new file mode 100644 index 0000000..4bb451f --- /dev/null +++ b/src/glyphs-widget.c @@ -0,0 +1,444 @@ +/* Widget-specific glyph objects. + Copyright (C) 1998 Andy Piper + +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. */ + +#include +#include "lisp.h" +#include "lstream.h" +#include "console.h" +#include "device.h" +#include "faces.h" +#include "glyphs.h" +#include "objects.h" + +#include "window.h" +#include "buffer.h" +#include "frame.h" +#include "insdel.h" +#include "opaque.h" + +DEFINE_IMAGE_INSTANTIATOR_FORMAT (button); +DEFINE_IMAGE_INSTANTIATOR_FORMAT (combo); +Lisp_Object Qcombo; +DEFINE_IMAGE_INSTANTIATOR_FORMAT (edit); +Lisp_Object Qedit; +DEFINE_IMAGE_INSTANTIATOR_FORMAT (scrollbar); +Lisp_Object Qscrollbar; +DEFINE_IMAGE_INSTANTIATOR_FORMAT (widget); +#if 0 +DEFINE_IMAGE_INSTANTIATOR_FORMAT (group); +Lisp_Object Qgroup; +#endif +DEFINE_IMAGE_INSTANTIATOR_FORMAT (label); +Lisp_Object Qlabel; + +Lisp_Object Q_descriptor, Q_height, Q_width, Q_properties, Q_items; + +#define WIDGET_BORDER_HEIGHT 2 +#define WIDGET_BORDER_WIDTH 4 + +/* TODO: + - more complex controls. + - tooltips for controls. + - images in controls. + */ + +/* In windows normal windows work in pixels, dialog boxes work in + dialog box units. Why? sigh. We could reuse the metrics for dialogs + if this were not the case. As it is we have to position things + pixel wise. I'm not even sure that X has this problem at least for + buttons in groups. */ +Lisp_Object +widget_face_font_info (Lisp_Object domain, Lisp_Object face, + int *height, int *width) +{ + Lisp_Object font_instance = FACE_FONT (face, domain, Vcharset_ascii); + + if (height) + *height = XFONT_INSTANCE (font_instance)->height; + if (width) + *width = XFONT_INSTANCE (font_instance)->width; + + return font_instance; +} + +void +widget_text_to_pixel_conversion (Lisp_Object domain, Lisp_Object face, + int th, int tw, + int* height, int* width) +{ + int ch=0, cw=0; + widget_face_font_info (domain, face, &ch, &cw); + if (height) + *height = th * (ch + 2 * WIDGET_BORDER_HEIGHT); + if (width) + *width = tw * cw + 2 * WIDGET_BORDER_WIDTH; +} + +static int +widget_possible_dest_types (void) +{ + return IMAGE_WIDGET_MASK; +} + +#if 0 /* currently unused */ +static void +check_valid_glyph (Lisp_Object data) +{ + if (SYMBOLP (data)) + CHECK_BUFFER_GLYPH (XSYMBOL (data)->value); + else + CHECK_BUFFER_GLYPH (data); +} +#endif /* currently unused */ + +static void +check_valid_item_list (Lisp_Object data) +{ + Lisp_Object rest; + Lisp_Object items; + Fcheck_valid_plist (data); + + items = Fplist_get (data, Q_items, Qnil); + + CHECK_LIST (items); + EXTERNAL_LIST_LOOP (rest, items) + { + CHECK_STRING (XCAR (rest)); + } +} + +/* wire widget property invocations to specific widgets ... The + problem we are solving here is that when instantiators get converted + to instances they lose some type information (they just become + subwindows or widgets for example). For widgets we need to preserve + this type information so that we can do widget specific operations on + the instances. This is encoded in the widget type + field. widget_property gets invoked by decoding the primary type + (Qwidget), widget property then invokes based on the secondary type + (Qedit for example). It is debatable that we should wire things in this + generalised way rather than treating widgets specially in + image_instance_property. */ +static Lisp_Object +widget_property (Lisp_Object image_instance, Lisp_Object prop) +{ + struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + struct image_instantiator_methods* meths; + + /* first see if its a general property ... */ + if (!NILP (Fplist_member (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop))) + return Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, Qnil); + + /* .. then try device specific methods ... */ + meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), + IMAGE_INSTANCE_WIDGET_TYPE (ii), + ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, property)) + return IIFORMAT_METH (meths, property, (image_instance, prop)); + /* ... then format specific methods ... */ + meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii), + ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, property)) + return IIFORMAT_METH (meths, property, (image_instance, prop)); + /* ... then fail */ + return Qunbound; +} + +static Lisp_Object +widget_set_property (Lisp_Object image_instance, Lisp_Object prop, Lisp_Object val) +{ + struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + struct image_instantiator_methods* meths; + Lisp_Object ret; + + /* try device specific methods first ... */ + meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), + IMAGE_INSTANCE_WIDGET_TYPE (ii), + ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, set_property) + && + !UNBOUNDP (ret = + IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) + { + return ret; + } + /* ... then format specific methods ... */ + meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii), + ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, set_property) + && + !UNBOUNDP (ret = + IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) + { + return ret; + } + /* we didn't do any device specific properties, so shove the property in our plist */ + IMAGE_INSTANCE_WIDGET_PROPS (ii) + = Fplist_put (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, val); + return val; +} + +static void +widget_validate (Lisp_Object instantiator) +{ + Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor); + struct gui_item gui; + if (NILP (desc)) + signal_simple_error ("Must supply :descriptor", instantiator); + + gui_parse_item_keywords (desc, &gui); + + if (!NILP (find_keyword_in_vector (instantiator, Q_width)) + && !NILP (find_keyword_in_vector (instantiator, Q_pixel_width))) + signal_simple_error ("Must supply only one of :width and :pixel-width", instantiator); + + if (!NILP (find_keyword_in_vector (instantiator, Q_height)) + && !NILP (find_keyword_in_vector (instantiator, Q_pixel_height))) + signal_simple_error ("Must supply only one of :height and :pixel-height", instantiator); +} + +static void +combo_validate (Lisp_Object instantiator) +{ + widget_validate (instantiator); + if (NILP (find_keyword_in_vector (instantiator, Q_properties))) + signal_simple_error ("Must supply item list", instantiator); +} + +static void +initialize_widget_image_instance (struct Lisp_Image_Instance *ii, Lisp_Object type) +{ + /* initialize_subwindow_image_instance (ii);*/ + IMAGE_INSTANCE_WIDGET_TYPE (ii) = type; + IMAGE_INSTANCE_WIDGET_PROPS (ii) = Qnil; + IMAGE_INSTANCE_WIDGET_FACE (ii) = Vwidget_face; + gui_item_init (&IMAGE_INSTANCE_WIDGET_ITEM (ii)); +} + +/* Instantiate a button widget. Unfortunately instantiated widgets are + particular to a frame since they need to have a parent. It's not + like images where you just select the image into the context you + want to display it in and BitBlt it. So images instances can have a + many-to-one relationship with things you see, whereas widgets can + only be one-to-one (i.e. per frame) */ +static void +widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain, int default_textheight, + int default_pixheight) +{ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii); + Lisp_Object face = find_keyword_in_vector (instantiator, Q_face); + Lisp_Object height = find_keyword_in_vector (instantiator, Q_height); + Lisp_Object width = find_keyword_in_vector (instantiator, Q_width); + Lisp_Object pixwidth = find_keyword_in_vector (instantiator, Q_pixel_width); + Lisp_Object pixheight = find_keyword_in_vector (instantiator, Q_pixel_height); + Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor); + int pw=0, ph=0, tw=0, th=0; + + /* this just does pixel type sizing */ + subwindow_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, + dest_mask, domain); + + if (!(dest_mask & IMAGE_WIDGET_MASK)) + incompatible_image_types (instantiator, dest_mask, IMAGE_WIDGET_MASK); + + initialize_widget_image_instance (ii, XVECTOR_DATA (instantiator)[0]); + + /* retrieve the fg and bg colors */ + if (!NILP (face)) + IMAGE_INSTANCE_WIDGET_FACE (ii) = Fget_face (face); + + /* data items for some widgets */ + IMAGE_INSTANCE_WIDGET_PROPS (ii) = + find_keyword_in_vector (instantiator, Q_properties); + + /* retrieve the gui item information */ + if (STRINGP (desc) || NILP (desc)) + IMAGE_INSTANCE_WIDGET_TEXT (ii) = desc; + else + gui_parse_item_keywords (find_keyword_in_vector (instantiator, Q_descriptor), + pgui); + + /* normalize size information */ + if (!NILP (width)) + tw = XINT (width); + if (!NILP (height)) + th = XINT (height); + if (!NILP (pixwidth)) + pw = XINT (pixwidth); + if (!NILP (pixheight)) + ph = XINT (pixheight); + + if (!tw && !pw && !NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) + tw = XSTRING_LENGTH (IMAGE_INSTANCE_WIDGET_TEXT (ii)); + if (!th && !ph) + { + if (default_textheight) + th = default_textheight; + else if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) + th = 1; + else + ph = default_pixheight; + } + + if (tw !=0 || th !=0) + widget_text_to_pixel_conversion (domain, + IMAGE_INSTANCE_WIDGET_FACE (ii), + th, tw, th ? &ph : 0, tw ? &pw : 0); + + IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = pw; + IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = ph; +} + +static void +widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + widget_instantiate_1 (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, 1, 0); +} + +static void +combo_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + Lisp_Object data = Fplist_get (find_keyword_in_vector (instantiator, Q_properties), + Q_items, Qnil); + int len; + GET_LIST_LENGTH (data, len); + widget_instantiate_1 (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, len + 1, 0); +} + +/* Instantiate a static control */ +static void +static_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + widget_instantiate_1 (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, 0, 4); +} + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_glyphs_widget (void) +{ + defkeyword (&Q_descriptor, ":descriptor"); + defkeyword (&Q_height, ":height"); + defkeyword (&Q_width, ":width"); + defkeyword (&Q_properties, ":properties"); + defkeyword (&Q_items, ":items"); +} + +void +image_instantiator_format_create_glyphs_widget (void) +{ + /* we only do this for properties */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM (widget, "widget"); + IIFORMAT_HAS_METHOD (widget, property); + IIFORMAT_HAS_METHOD (widget, set_property); + + /* widget image-instantiator types - buttons */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (button, "button"); + IIFORMAT_HAS_SHARED_METHOD (button, validate, widget); + IIFORMAT_HAS_SHARED_METHOD (button, possible_dest_types, widget); + IIFORMAT_HAS_SHARED_METHOD (button, instantiate, widget); + + IIFORMAT_VALID_KEYWORD (button, Q_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (button, Q_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (button, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (button, Q_pixel_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (button, Q_face, check_valid_face); + IIFORMAT_VALID_KEYWORD (button, Q_descriptor, check_valid_vector); + /* edit fields */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (edit, "edit"); + IIFORMAT_HAS_SHARED_METHOD (edit, validate, widget); + IIFORMAT_HAS_SHARED_METHOD (edit, possible_dest_types, widget); + IIFORMAT_HAS_SHARED_METHOD (edit, instantiate, widget); + + IIFORMAT_VALID_KEYWORD (edit, Q_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (edit, Q_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (edit, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (edit, Q_pixel_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (edit, Q_face, check_valid_face); + IIFORMAT_VALID_KEYWORD (edit, Q_descriptor, check_valid_vector); + /* combo box */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (combo, "combo"); + IIFORMAT_HAS_METHOD (combo, validate); + IIFORMAT_HAS_SHARED_METHOD (combo, possible_dest_types, widget); + IIFORMAT_HAS_METHOD (combo, instantiate); + + IIFORMAT_VALID_KEYWORD (combo, Q_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (combo, Q_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (combo, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (combo, Q_face, check_valid_face); + IIFORMAT_VALID_KEYWORD (combo, Q_descriptor, check_valid_vector); + IIFORMAT_VALID_KEYWORD (combo, Q_properties, check_valid_item_list); + /* scrollbar */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (scrollbar, "scrollbar"); + IIFORMAT_HAS_SHARED_METHOD (scrollbar, validate, widget); + IIFORMAT_HAS_SHARED_METHOD (scrollbar, possible_dest_types, widget); + IIFORMAT_HAS_SHARED_METHOD (scrollbar, instantiate, widget); + + IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (scrollbar, Q_face, check_valid_face); + IIFORMAT_VALID_KEYWORD (scrollbar, Q_descriptor, check_valid_vector); + /* labels */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (label, "label"); + IIFORMAT_HAS_SHARED_METHOD (label, possible_dest_types, widget); + IIFORMAT_HAS_SHARED_METHOD (label, instantiate, static); + + IIFORMAT_VALID_KEYWORD (label, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (label, Q_pixel_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (label, Q_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (label, Q_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (label, Q_face, check_valid_face); + IIFORMAT_VALID_KEYWORD (label, Q_descriptor, check_valid_string); +#if 0 + /* group */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (group, "group"); + IIFORMAT_HAS_SHARED_METHOD (group, possible_dest_types, widget); + IIFORMAT_HAS_METHOD (group, instantiate); + + IIFORMAT_VALID_KEYWORD (group, Q_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (group, Q_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (group, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (group, Q_pixel_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (group, Q_face, check_valid_face); + IIFORMAT_VALID_KEYWORD (group, Q_background, check_valid_string); + IIFORMAT_VALID_KEYWORD (group, Q_descriptor, check_valid_string); +#endif +} + +void +vars_of_glyphs_widget (void) +{ +} diff --git a/src/glyphs-x.c b/src/glyphs-x.c index 82cba3a..c6015e4 100644 --- a/src/glyphs-x.c +++ b/src/glyphs-x.c @@ -54,6 +54,7 @@ Boston, MA 02111-1307, USA. */ #include "xmu.h" #include "buffer.h" +#include "window.h" #include "frame.h" #include "insdel.h" #include "opaque.h" @@ -80,6 +81,11 @@ Boston, MA 02111-1307, USA. */ #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev))) +#ifdef HAVE_XPM +DEFINE_DEVICE_IIFORMAT (x, xpm); +#endif +DEFINE_DEVICE_IIFORMAT (x, xbm); +DEFINE_DEVICE_IIFORMAT (x, subwindow); #ifdef HAVE_XFACE DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface); Lisp_Object Qxface; @@ -314,10 +320,6 @@ x_print_image_instance (struct Lisp_Image_Instance *p, } write_c_string (")", printcharfun); break; -#if HAVE_SUBWINDOWS - case IMAGE_SUBWINDOW: - /* #### implement me */ -#endif default: break; } @@ -333,27 +335,38 @@ x_finalize_image_instance (struct Lisp_Image_Instance *p) { Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device)); - if (IMAGE_INSTANCE_X_PIXMAP (p)) - XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP (p)); - if (IMAGE_INSTANCE_X_MASK (p) && - IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p)) - XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p)); - IMAGE_INSTANCE_X_PIXMAP (p) = 0; - IMAGE_INSTANCE_X_MASK (p) = 0; - - if (IMAGE_INSTANCE_X_CURSOR (p)) + if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET + || + IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) { - XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p)); - IMAGE_INSTANCE_X_CURSOR (p) = 0; + if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) + XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); + IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0; } - - if (IMAGE_INSTANCE_X_NPIXELS (p) != 0) + else { - XFreeColors (dpy, - IMAGE_INSTANCE_X_COLORMAP (p), - IMAGE_INSTANCE_X_PIXELS (p), - IMAGE_INSTANCE_X_NPIXELS (p), 0); - IMAGE_INSTANCE_X_NPIXELS (p) = 0; + if (IMAGE_INSTANCE_X_PIXMAP (p)) + XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP (p)); + if (IMAGE_INSTANCE_X_MASK (p) && + IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p)) + XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p)); + IMAGE_INSTANCE_X_PIXMAP (p) = 0; + IMAGE_INSTANCE_X_MASK (p) = 0; + + if (IMAGE_INSTANCE_X_CURSOR (p)) + { + XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p)); + IMAGE_INSTANCE_X_CURSOR (p) = 0; + } + + if (IMAGE_INSTANCE_X_NPIXELS (p) != 0) + { + XFreeColors (dpy, + IMAGE_INSTANCE_X_COLORMAP (p), + IMAGE_INSTANCE_X_PIXELS (p), + IMAGE_INSTANCE_X_NPIXELS (p), 0); + IMAGE_INSTANCE_X_NPIXELS (p) = 0; + } } } if (IMAGE_INSTANCE_X_PIXELS (p)) @@ -378,10 +391,6 @@ x_image_instance_equal (struct Lisp_Image_Instance *p1, if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) || IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2)) return 0; -#if HAVE_SUBWINDOWS - case IMAGE_SUBWINDOW: - /* #### implement me */ -#endif break; default: break; @@ -399,11 +408,6 @@ x_image_instance_hash (struct Lisp_Image_Instance *p, int depth) case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: return IMAGE_INSTANCE_X_NPIXELS (p); -#if HAVE_SUBWINDOWS - case IMAGE_SUBWINDOW: - /* #### implement me */ - return 0; -#endif default: return 0; } @@ -2020,168 +2024,82 @@ x_colorize_image_instance (Lisp_Object image_instance, } -#if HAVE_SUBWINDOWS /************************************************************************/ -/* subwindows */ +/* subwindow and widget support */ /************************************************************************/ -Lisp_Object Qsubwindowp; - -static Lisp_Object -mark_subwindow (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Subwindow *sw = XSUBWINDOW (obj); - return sw->frame; -} - +/* unmap the image if it is a widget. This is used by redisplay via + redisplay_unmap_subwindows */ static void -print_subwindow (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +x_unmap_subwindow (struct Lisp_Image_Instance *p) { - char buf[100]; - struct Lisp_Subwindow *sw = XSUBWINDOW (obj); - struct frame *frm = XFRAME (sw->frame); - - if (print_readably) - error ("printing unreadable object #", - sw->header.uid); - - write_c_string ("#width, sw->height); - write_c_string (buf, printcharfun); - - /* This is stolen from frame.c. Subwindows are strange in that they - are specific to a particular frame so we want to print in their - description what that frame is. */ - - write_c_string (" on #<", printcharfun); - if (!FRAME_LIVE_P (frm)) - write_c_string ("dead", printcharfun); - else if (FRAME_TTY_P (frm)) - write_c_string ("tty", printcharfun); - else if (FRAME_X_P (frm)) - write_c_string ("x", printcharfun); - else - write_c_string ("UNKNOWN", printcharfun); - write_c_string ("-frame ", printcharfun); - print_internal (frm->name, printcharfun, 1); - sprintf (buf, " 0x%x>", frm->header.uid); - write_c_string (buf, printcharfun); - - sprintf (buf, ") 0x%x>", sw->header.uid); - write_c_string (buf, printcharfun); + XUnmapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), + IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); } +/* map the subwindow. This is used by redisplay via + redisplay_output_subwindow */ static void -finalize_subwindow (void *header, int for_disksave) -{ - struct Lisp_Subwindow *sw = (struct Lisp_Subwindow *) header; - if (for_disksave) finalose (sw); - if (sw->subwindow) - { - XDestroyWindow (DisplayOfScreen (sw->xscreen), sw->subwindow); - sw->subwindow = 0; - } -} - -/* subwindows are equal iff they have the same window XID */ -static int -subwindow_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) +x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y) { - return (XSUBWINDOW (obj1)->subwindow == XSUBWINDOW (obj2)->subwindow); + XMapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), + IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); + XMoveWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), + IMAGE_INSTANCE_X_SUBWINDOW_ID (p), x, y); } -static unsigned long -subwindow_hash (Lisp_Object obj, int depth) -{ - return XSUBWINDOW (obj)->subwindow; -} - -DEFINE_LRECORD_IMPLEMENTATION ("subwindow", subwindow, - mark_subwindow, print_subwindow, - finalize_subwindow, subwindow_equal, - subwindow_hash, struct Lisp_Subwindow); - -/* #### PROBLEM: The display routines assume that the glyph is only - being displayed in one buffer. If it is in two different buffers - which are both being displayed simultaneously you will lose big time. - This can be dealt with in the new redisplay. */ - -/* #### These are completely un-re-implemented in 19.14. Get it done - for 19.15. */ - -DEFUN ("make-subwindow", Fmake_subwindow, 0, 3, 0, /* -Creates a new `subwindow' object of size WIDTH x HEIGHT. -The default is a window of size 1x1, which is also the minimum allowed -window size. Subwindows are per-frame. A buffer being shown in two -different frames will only display a subwindow glyph in the frame in -which it was actually created. If two windows on the same frame are -displaying the buffer then the most recently used window will actually -display the window. If the frame is not specified, the selected frame -is used. - -Subwindows are not currently implemented. -*/ - (width, height, frame)) +/* instantiate and x type subwindow */ +static void +x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { + /* This function can GC */ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); + Lisp_Object frame = FW_FRAME (domain); + struct frame* f = XFRAME (frame); Display *dpy; Screen *xs; - Window pw; - struct frame *f; - unsigned int iw, ih; + Window pw, win; XSetWindowAttributes xswa; Mask valueMask = 0; + unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii), + h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii); - error ("subwindows are not functional in 20.2; they may be again someday"); - - f = decode_x_frame (frame); + if (!DEVICE_X_P (XDEVICE (device))) + signal_simple_error ("Not an X device", device); - xs = LISP_DEVICE_TO_X_SCREEN (FRAME_DEVICE (f)); - dpy = DisplayOfScreen (xs); - pw = XtWindow (FRAME_X_TEXT_WIDGET (f)); + dpy = DEVICE_X_DISPLAY (XDEVICE (device)); + xs = DefaultScreenOfDisplay (dpy); - if (NILP (width)) - iw = 1; - else - { - CHECK_INT (width); - iw = XINT (width); - if (iw < 1) iw = 1; - } - if (NILP (height)) - ih = 1; + if (dest_mask & IMAGE_SUBWINDOW_MASK) + IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW; else - { - CHECK_INT (height); - ih = XINT (height); - if (ih < 1) ih = 1; - } + incompatible_image_types (instantiator, dest_mask, + IMAGE_SUBWINDOW_MASK); - { - struct Lisp_Subwindow *sw = - alloc_lcrecord_type (struct Lisp_Subwindow, lrecord_subwindow); - Lisp_Object val; - sw->frame = frame; - sw->xscreen = xs; - sw->parent_window = pw; - sw->height = ih; - sw->width = iw; - - xswa.backing_store = Always; - valueMask |= CWBackingStore; - - xswa.colormap = DefaultColormapOfScreen (xs); - valueMask |= CWColormap; - - sw->subwindow = XCreateWindow (dpy, pw, 0, 0, iw, ih, 0, CopyFromParent, - InputOutput, CopyFromParent, valueMask, - &xswa); - - XSETSUBWINDOW (val, sw); - return val; - } + pw = XtWindow (FRAME_X_TEXT_WIDGET (f)); + + ii->data = xnew_and_zero (struct x_subwindow_data); + + IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw; + IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii) = xs; + + xswa.backing_store = Always; + valueMask |= CWBackingStore; + xswa.colormap = DefaultColormapOfScreen (xs); + valueMask |= CWColormap; + + win = XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent, + InputOutput, CopyFromParent, valueMask, + &xswa); + + IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win; } -/* #### Should this function exist? */ +#if 0 +/* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */ DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /* For the given SUBWINDOW, set PROPERTY to DATA, which is a string. Subwindows are not currently implemented. @@ -2208,91 +2126,16 @@ Subwindows are not currently implemented. return property; } +#endif -DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /* -Return non-nil if OBJECT is a subwindow. -Subwindows are not currently implemented. -*/ - (object)) -{ - return SUBWINDOWP (object) ? Qt : Qnil; -} - -DEFUN ("subwindow-width", Fsubwindow_width, 1, 1, 0, /* -Width of SUBWINDOW. -Subwindows are not currently implemented. -*/ - (subwindow)) -{ - CHECK_SUBWINDOW (subwindow); - return make_int (XSUBWINDOW (subwindow)->width); -} - -DEFUN ("subwindow-height", Fsubwindow_height, 1, 1, 0, /* -Height of SUBWINDOW. -Subwindows are not currently implemented. -*/ - (subwindow)) -{ - CHECK_SUBWINDOW (subwindow); - return make_int (XSUBWINDOW (subwindow)->height); -} - -DEFUN ("subwindow-xid", Fsubwindow_xid, 1, 1, 0, /* -Return the xid of SUBWINDOW as a number. -Subwindows are not currently implemented. -*/ - (subwindow)) -{ - CHECK_SUBWINDOW (subwindow); - return make_int (XSUBWINDOW (subwindow)->subwindow); -} - -DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /* -Resize SUBWINDOW to WIDTH x HEIGHT. -If a value is nil that parameter is not changed. -Subwindows are not currently implemented. -*/ - (subwindow, width, height)) +static void +x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h) { - int neww, newh; - struct Lisp_Subwindow *sw; - - CHECK_SUBWINDOW (subwindow); - sw = XSUBWINDOW (subwindow); - - if (NILP (width)) - neww = sw->width; - else - neww = XINT (width); - - if (NILP (height)) - newh = sw->height; - else - newh = XINT (height); - - XResizeWindow (DisplayOfScreen (sw->xscreen), sw->subwindow, neww, newh); - - sw->height = newh; - sw->width = neww; - - return subwindow; + XResizeWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii)), + IMAGE_INSTANCE_X_SUBWINDOW_ID (ii), + w, h); } -DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /* -Generate a Map event for SUBWINDOW. -Subwindows are not currently implemented. -*/ - (subwindow)) -{ - CHECK_SUBWINDOW (subwindow); - - XMapWindow (DisplayOfScreen (XSUBWINDOW (subwindow)->xscreen), - XSUBWINDOW (subwindow)->subwindow); - - return subwindow; -} -#endif /************************************************************************/ /* initialization */ @@ -2301,17 +2144,8 @@ Subwindows are not currently implemented. void syms_of_glyphs_x (void) { -#if HAVE_SUBWINDOWS - defsymbol (&Qsubwindowp, "subwindowp"); - - DEFSUBR (Fmake_subwindow); +#if 0 DEFSUBR (Fchange_subwindow_property); - DEFSUBR (Fsubwindowp); - DEFSUBR (Fsubwindow_width); - DEFSUBR (Fsubwindow_height); - DEFSUBR (Fsubwindow_xid); - DEFSUBR (Fresize_subwindow); - DEFSUBR (Fforce_subwindow_map); #endif } @@ -2327,15 +2161,23 @@ console_type_create_glyphs_x (void) CONSOLE_HAS_METHOD (x, colorize_image_instance); CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage); CONSOLE_HAS_METHOD (x, locate_pixmap_file); -#ifdef HAVE_XPM - CONSOLE_HAS_METHOD (x, xpm_instantiate); -#endif - CONSOLE_HAS_METHOD (x, xbm_instantiate); + CONSOLE_HAS_METHOD (x, unmap_subwindow); + CONSOLE_HAS_METHOD (x, map_subwindow); + CONSOLE_HAS_METHOD (x, resize_subwindow); } void image_instantiator_format_create_glyphs_x (void) { +#ifdef HAVE_XPM + INITIALIZE_DEVICE_IIFORMAT (x, xpm); + IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate); +#endif + INITIALIZE_DEVICE_IIFORMAT (x, xbm); + IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate); + + INITIALIZE_DEVICE_IIFORMAT (x, subwindow); + IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate); INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font"); diff --git a/src/glyphs-x.h b/src/glyphs-x.h index 68980fa..ed77321 100644 --- a/src/glyphs-x.h +++ b/src/glyphs-x.h @@ -74,33 +74,28 @@ struct x_image_instance_data #define XIMAGE_INSTANCE_X_NPIXELS(i) \ IMAGE_INSTANCE_X_NPIXELS (XIMAGE_INSTANCE (i)) -/* Set to 1 if you wish to implement this feature */ -# define HAVE_SUBWINDOWS 0 -# if HAVE_SUBWINDOWS /**************************************************************************** * Subwindow Object * ****************************************************************************/ -DECLARE_LRECORD (subwindow, struct Lisp_Subwindow); -#define XSUBWINDOW(x) XRECORD (x, subwindow, struct Lisp_Subwindow) -#define XSETSUBWINDOW(x, p) XSETRECORD (x, p, subwindow) -#define SUBWINDOWP(x) RECORDP (x, subwindow) -#define GC_SUBWINDOWP(x) GC_RECORDP (x, subwindow) -#define CHECK_SUBWINDOW(x) CHECK_RECORD (x, subwindow) - -struct Lisp_Subwindow +struct x_subwindow_data { - struct lcrecord_header header; - Lisp_Object frame; Screen *xscreen; Window parent_window; - - unsigned int width, height; - Window subwindow; - - int being_displayed; /* used to detect when needs to be unmapped */ }; -# endif + +#define X_SUBWINDOW_INSTANCE_DATA(i) ((struct x_subwindow_data *) (i)->data) + +#define IMAGE_INSTANCE_X_SUBWINDOW_SCREEN(i) \ + (X_SUBWINDOW_INSTANCE_DATA (i)->xscreen) +#define IMAGE_INSTANCE_X_SUBWINDOW_PARENT(i) \ + (X_SUBWINDOW_INSTANCE_DATA (i)->parent_window) +#define XIMAGE_INSTANCE_X_SUBWINDOW_PARENT(i) \ + IMAGE_INSTANCE_X_SUBWINDOW_PARENT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_X_SUBWINDOW_SCREEN(i) \ + IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (XIMAGE_INSTANCE (i)) +#define IMAGE_INSTANCE_X_SUBWINDOW_ID(i) \ + ((Window) IMAGE_INSTANCE_SUBWINDOW_ID (i)) #endif /* HAVE_X_WINDOWS */ #endif /* _XEMACS_GLYPHS_X_H_ */ diff --git a/src/glyphs.c b/src/glyphs.c index 8444f4a..fff0de9 100644 --- a/src/glyphs.c +++ b/src/glyphs.c @@ -3,6 +3,7 @@ Copyright (C) 1995 Tinker Systems Copyright (C) 1995, 1996 Ben Wing Copyright (C) 1995 Sun Microsystems + Copyright (C) 1998 Andy Piper This file is part of XEmacs. @@ -34,10 +35,13 @@ Boston, MA 02111-1307, USA. */ #include "faces.h" #include "frame.h" #include "insdel.h" -#include "glyphs.h" +#include "opaque.h" #include "objects.h" #include "redisplay.h" #include "window.h" +#include "frame.h" +#include "chartab.h" +#include "rangetab.h" #ifdef HAVE_XPM #include @@ -52,11 +56,11 @@ Lisp_Object Qmono_pixmap_image_instance_p; Lisp_Object Qcolor_pixmap_image_instance_p; Lisp_Object Qpointer_image_instance_p; Lisp_Object Qsubwindow_image_instance_p; +Lisp_Object Qwidget_image_instance_p; Lisp_Object Qconst_glyph_variable; Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow; -Lisp_Object Q_file, Q_data, Q_face; +Lisp_Object Q_file, Q_data, Q_face, Q_pixel_width, Q_pixel_height; Lisp_Object Qformatted_string; - Lisp_Object Vcurrent_display_table; Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph; Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph; @@ -70,6 +74,7 @@ DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing); DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit); DEFINE_IMAGE_INSTANTIATOR_FORMAT (string); DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); +DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow); #ifdef HAVE_WINDOW_SYSTEM DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm); @@ -95,6 +100,7 @@ typedef struct image_instantiator_format_entry image_instantiator_format_entry; struct image_instantiator_format_entry { Lisp_Object symbol; + Lisp_Object device; struct image_instantiator_methods *meths; }; @@ -119,8 +125,9 @@ EXFUN (Fglyph_type, 1); * Image Instantiators * ****************************************************************************/ -static struct image_instantiator_methods * -decode_image_instantiator_format (Lisp_Object format, Error_behavior errb) +struct image_instantiator_methods * +decode_device_ii_format (Lisp_Object device, Lisp_Object format, + Error_behavior errb) { int i; @@ -134,10 +141,19 @@ decode_image_instantiator_format (Lisp_Object format, Error_behavior errb) for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr); i++) { - if (EQ (format, - Dynarr_at (the_image_instantiator_format_entry_dynarr, i). - symbol)) - return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths; + if ( EQ (format, + Dynarr_at (the_image_instantiator_format_entry_dynarr, i). + symbol) ) + { + Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i). + device; + if ((NILP (d) && NILP (device)) + || + (!NILP (device) && + EQ (CONSOLE_TYPE (XCONSOLE + (DEVICE_CONSOLE (XDEVICE (device)))), d))) + return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths; + } } maybe_signal_simple_error ("Invalid image-instantiator format", format, @@ -146,6 +162,12 @@ decode_image_instantiator_format (Lisp_Object format, Error_behavior errb) return 0; } +struct image_instantiator_methods * +decode_image_instantiator_format (Lisp_Object format, Error_behavior errb) +{ + return decode_device_ii_format (Qnil, format, errb); +} + static int valid_image_instantiator_format_p (Lisp_Object format) { @@ -157,7 +179,7 @@ DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p, Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid. Valid formats are some subset of 'nothing, 'string, 'formatted-string, 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font, -'autodetect, and 'subwindow, depending on how XEmacs was compiled. +'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled. */ (image_instantiator_format)) { @@ -175,19 +197,27 @@ Return a list of valid image-instantiator formats. } void -add_entry_to_image_instantiator_format_list (Lisp_Object symbol, - struct - image_instantiator_methods *meths) +add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol, + struct image_instantiator_methods *meths) { struct image_instantiator_format_entry entry; entry.symbol = symbol; + entry.device = device; entry.meths = meths; Dynarr_add (the_image_instantiator_format_entry_dynarr, entry); Vimage_instantiator_format_list = Fcons (symbol, Vimage_instantiator_format_list); } +void +add_entry_to_image_instantiator_format_list (Lisp_Object symbol, + struct + image_instantiator_methods *meths) +{ + add_entry_to_device_ii_format_list (Qnil, symbol, meths); +} + static Lisp_Object * get_image_conversion_list (Lisp_Object console_type) { @@ -355,7 +385,13 @@ check_valid_string (Lisp_Object data) CHECK_STRING (data); } -static void +void +check_valid_vector (Lisp_Object data) +{ + CHECK_VECTOR (data); +} + +void check_valid_face (Lisp_Object data) { Fget_face (data); @@ -481,12 +517,16 @@ normalize_image_instantiator (Lisp_Object instantiator, longer exist (e.g. w3 pixmaps are almost always from temporary files). */ { - struct image_instantiator_methods * meths = - decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], - ERROR_ME); - return IIFORMAT_METH_OR_GIVEN (meths, normalize, - (instantiator, contype), - instantiator); + struct gcpro gcpro1; + struct image_instantiator_methods *meths; + + GCPRO1 (instantiator); + + meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], + ERROR_ME); + RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize, + (instantiator, contype), + instantiator)); } } @@ -499,16 +539,25 @@ instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain, Lisp_Object ii = allocate_image_instance (device); struct image_instantiator_methods *meths; struct gcpro gcpro1; + int methp = 0; GCPRO1 (ii); meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], ERROR_ME); - if (!HAS_IIFORMAT_METH_P (meths, instantiate)) + methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate); + MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg, + pointer_bg, dest_mask, domain)); + + /* now do device specific instantiation */ + meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0], + ERROR_ME_NOT); + + if (!methp && (!meths || !HAS_IIFORMAT_METH_P (meths, instantiate))) signal_simple_error ("Don't know how to instantiate this image instantiator?", instantiator); - IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg, - pointer_bg, dest_mask, domain)); + MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg, + pointer_bg, dest_mask, domain)); UNGCPRO; return ii; @@ -541,9 +590,16 @@ mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) markobj (IMAGE_INSTANCE_PIXMAP_FG (i)); markobj (IMAGE_INSTANCE_PIXMAP_BG (i)); break; + + case IMAGE_WIDGET: + markobj (IMAGE_INSTANCE_WIDGET_TYPE (i)); + markobj (IMAGE_INSTANCE_WIDGET_PROPS (i)); + markobj (IMAGE_INSTANCE_WIDGET_FACE (i)); + mark_gui_item (&IMAGE_INSTANCE_WIDGET_ITEM (i), markobj); case IMAGE_SUBWINDOW: - /* #### implement me */ + markobj (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)); break; + default: break; } @@ -645,8 +701,48 @@ print_image_instance (Lisp_Object obj, Lisp_Object printcharfun, } break; + case IMAGE_WIDGET: + if (!NILP (IMAGE_INSTANCE_WIDGET_CALLBACK (ii))) + { + print_internal (IMAGE_INSTANCE_WIDGET_CALLBACK (ii), printcharfun, 0); + write_c_string (", ", printcharfun); + } + if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii))) + { + write_c_string (" (", printcharfun); + print_internal + (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0); + write_c_string (")", printcharfun); + } + + if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) + print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0); + case IMAGE_SUBWINDOW: - /* #### implement me */ + sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii), + IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); + write_c_string (buf, printcharfun); + + /* This is stolen from frame.c. Subwindows are strange in that they + are specific to a particular frame so we want to print in their + description what that frame is. */ + + write_c_string (" on #<", printcharfun); + { + struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); + + if (!FRAME_LIVE_P (f)) + write_c_string ("dead", printcharfun); + else + write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))), + printcharfun); + + write_c_string ("-frame ", printcharfun); + } + write_c_string (">", printcharfun); + sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); + write_c_string (buf, printcharfun); + break; default: @@ -669,6 +765,15 @@ finalize_image_instance (void *header, int for_disksave) return; if (for_disksave) finalose (i); + /* do this so that the cachels get reset */ + if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET + || + IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW) + { + MARK_FRAME_GLYPHS_CHANGED + (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i))); + } + MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i)); } @@ -722,8 +827,26 @@ image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) return 0; break; + case IMAGE_WIDGET: + if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1), + IMAGE_INSTANCE_WIDGET_TYPE (i2)) && + EQ (IMAGE_INSTANCE_WIDGET_CALLBACK (i1), + IMAGE_INSTANCE_WIDGET_CALLBACK (i2)) + && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1), + IMAGE_INSTANCE_WIDGET_PROPS (i2), + depth + 1) + && internal_equal (IMAGE_INSTANCE_WIDGET_TEXT (i1), + IMAGE_INSTANCE_WIDGET_TEXT (i2), + depth + 1))) + return 0; case IMAGE_SUBWINDOW: - /* #### implement me */ + if (!(IMAGE_INSTANCE_SUBWINDOW_WIDTH (i1) == + IMAGE_INSTANCE_SUBWINDOW_WIDTH (i2) && + IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i1) == + IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i2) && + IMAGE_INSTANCE_SUBWINDOW_ID (i1) == + IMAGE_INSTANCE_SUBWINDOW_ID (i2))) + return 0; break; default: @@ -760,8 +883,15 @@ image_instance_hash (Lisp_Object obj, int depth) depth + 1)); break; + case IMAGE_WIDGET: + hash = HASH4 (hash, + internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1), + internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1), + internal_hash (IMAGE_INSTANCE_WIDGET_CALLBACK (i), depth + 1)); case IMAGE_SUBWINDOW: - /* #### implement me */ + hash = HASH4 (hash, IMAGE_INSTANCE_SUBWINDOW_WIDTH (i), + IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i), + (int) IMAGE_INSTANCE_SUBWINDOW_ID (i)); break; default: @@ -805,6 +935,7 @@ decode_image_instance_type (Lisp_Object type, Error_behavior errb) if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP; if (EQ (type, Qpointer)) return IMAGE_POINTER; if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW; + if (EQ (type, Qwidget)) return IMAGE_WIDGET; maybe_signal_simple_error ("Invalid image-instance type", type, Qimage, errb); @@ -823,6 +954,7 @@ encode_image_instance_type (enum image_instance_type type) case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap; case IMAGE_POINTER: return Qpointer; case IMAGE_SUBWINDOW: return Qsubwindow; + case IMAGE_WIDGET: return Qwidget; default: abort (); } @@ -1069,17 +1201,94 @@ Return the name of the given image instance. DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /* Return the string of the given image instance. -This will only be non-nil for text image instances. +This will only be non-nil for text image instances and widgets. */ (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT) return XIMAGE_INSTANCE_TEXT_STRING (image_instance); + else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET) + return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance); else return Qnil; } +DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /* +Return the given property of the given image instance. +Returns nil if the property or the property method do not exist for +the image instance in the domain. +*/ + (image_instance, prop)) +{ + struct Lisp_Image_Instance* ii; + Lisp_Object type, ret; + struct image_instantiator_methods* meths; + + CHECK_IMAGE_INSTANCE (image_instance); + CHECK_SYMBOL (prop); + ii = XIMAGE_INSTANCE (image_instance); + + /* ... then try device specific methods ... */ + type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); + meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), + type, ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, property) + && + !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop)))) + { + return ret; + } + /* ... then format specific methods ... */ + meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, property) + && + !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop)))) + { + return ret; + } + /* ... then fail */ + return Qnil; +} + +DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /* +Set the given property of the given image instance. +Does nothing if the property or the property method do not exist for +the image instance in the domain. +*/ + (image_instance, prop, val)) +{ + struct Lisp_Image_Instance* ii; + Lisp_Object type, ret; + struct image_instantiator_methods* meths; + + CHECK_IMAGE_INSTANCE (image_instance); + CHECK_SYMBOL (prop); + ii = XIMAGE_INSTANCE (image_instance); + type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); + /* try device specific methods first ... */ + meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), + type, ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, set_property) + && + !UNBOUNDP (ret = + IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) + { + return ret; + } + /* ... then format specific methods ... */ + meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, set_property) + && + !UNBOUNDP (ret = + IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) + { + return ret; + } + + return val; +} + DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /* Return the file name from which IMAGE-INSTANCE was read, if known. */ @@ -1152,6 +1361,10 @@ Return the height of the image instance, in pixels. case IMAGE_POINTER: return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance)); + case IMAGE_SUBWINDOW: + case IMAGE_WIDGET: + return make_int (XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (image_instance)); + default: return Qnil; } @@ -1171,6 +1384,10 @@ Return the width of the image instance, in pixels. case IMAGE_POINTER: return make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance)); + case IMAGE_SUBWINDOW: + case IMAGE_WIDGET: + return make_int (XIMAGE_INSTANCE_SUBWINDOW_WIDTH (image_instance)); + default: return Qnil; } @@ -1240,6 +1457,12 @@ colorized mono pixmaps and for pointers.) case IMAGE_POINTER: return XIMAGE_INSTANCE_PIXMAP_FG (image_instance); + case IMAGE_WIDGET: + return FACE_FOREGROUND ( + XIMAGE_INSTANCE_WIDGET_FACE (image_instance), + XIMAGE_INSTANCE_SUBWINDOW_FRAME + (image_instance)); + default: return Qnil; } @@ -1261,6 +1484,12 @@ colorized mono pixmaps and for pointers.) case IMAGE_POINTER: return XIMAGE_INSTANCE_PIXMAP_BG (image_instance); + case IMAGE_WIDGET: + return FACE_BACKGROUND ( + XIMAGE_INSTANCE_WIDGET_FACE (image_instance), + XIMAGE_INSTANCE_SUBWINDOW_FRAME + (image_instance)); + default: return Qnil; } @@ -1769,19 +1998,6 @@ xbm_possible_dest_types (void) IMAGE_POINTER_MASK; } -static void -xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object device= IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (image_instance)); - - MAYBE_DEVMETH (XDEVICE (device), - xbm_instantiate, - (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain)); -} - #endif @@ -1796,8 +2012,10 @@ pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid) { char **data; int result; - - result = XpmReadFileToData ((char *) XSTRING_DATA (name), &data); + char *fname = 0; + + GET_C_STRING_FILENAME_DATA_ALLOCA (name, fname); + result = XpmReadFileToData (fname, &data); if (result == XpmSuccess) { @@ -1994,19 +2212,6 @@ xpm_possible_dest_types (void) IMAGE_POINTER_MASK; } -static void -xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object device= IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (image_instance)); - - MAYBE_DEVMETH (XDEVICE (device), - xpm_instantiate, - (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain)); -} - #endif /* HAVE_XPM */ @@ -2109,7 +2314,7 @@ image_instantiate (Lisp_Object specifier, Lisp_Object matchspec, /* For the image instance cache, we do comparisons with EQ rather than with EQUAL, as we do for color and font names. The reasons are: - + 1) pixmap data can be very long, and thus the hashing and comparing will take awhile. 2) It's not so likely that we'll run into things that are EQUAL @@ -2133,8 +2338,28 @@ image_instantiate (Lisp_Object specifier, Lisp_Object matchspec, instance = Qunbound; } else - instance = Fgethash (pointerp ? ls3 : instantiator, - subtable, Qunbound); + { + instance = Fgethash (pointerp ? ls3 : instantiator, + subtable, Qunbound); + /* subwindows have a per-window cache and have to be treated + differently. dest_mask can be a bitwise OR of all image + types so we will only catch someone possibly trying to + instantiate a subwindow type thing. Unfortunately, this + will occur most of the time so this probably slows things + down. But with the current design I don't see anyway + round it. */ + if (UNBOUNDP (instance) + && + dest_mask & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) + { + if (!WINDOWP (domain)) + signal_simple_error ("Can't instantiate subwindow outside a window", + instantiator); + instance = Fgethash (instantiator, + XWINDOW (domain)->subwindow_instance_cache, + Qunbound); + } + } if (UNBOUNDP (instance)) { @@ -2143,7 +2368,7 @@ image_instantiate (Lisp_Object specifier, Lisp_Object matchspec, noseeum_cons (pointerp ? ls3 : instantiator, subtable)); int speccount = specpdl_depth (); - + /* make sure we cache the failures, too. Use an unwind-protect to catch such errors. If we fail, the unwind-protect records nil in @@ -2157,7 +2382,21 @@ image_instantiate (Lisp_Object specifier, Lisp_Object matchspec, instantiator, pointer_fg, pointer_bg, dest_mask); + Fsetcar (locative, instance); + /* only after the image has been instantiated do we know + whether we need to put it in the per-window image instance + cache. */ + if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) + & + (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) + { + if (!WINDOWP (domain)) + signal_simple_error ("Can't instantiate subwindow outside a window", + instantiator); + + Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache ); + } unbind_to (speccount, Qnil); } else @@ -2357,7 +2596,7 @@ pairs. FORMAT should be one of (Display this image as a text string, with replaceable fields; not currently implemented.) 'xbm - (An X bitmap; only if X support was compiled into this XEmacs. + (An X bitmap; only if X or Windows support was compiled into this XEmacs. Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.) 'xpm (An XPM pixmap; only if XPM support was compiled into this XEmacs. @@ -2393,6 +2632,8 @@ pairs. FORMAT should be one of probably be fixed.) 'subwindow (An embedded X window; not currently implemented.) +'widget + (A widget control, for instance text field or radio button.) 'autodetect (XEmacs tries to guess what format the data is in. If X support exists, the data string will be checked to see if it names a filename. @@ -2423,7 +2664,7 @@ The valid keywords are: `cursor-font', `font', `autodetect', and `inherit'.) :foreground :background - (For `xbm', `xface', `cursor-font', and `font'. These keywords + (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords allow you to explicitly specify foreground and background colors. The argument should be anything acceptable to `make-color-instance'. This will cause what would be a `mono-pixmap' to instead be colorized @@ -2628,8 +2869,9 @@ allocate_glyph (enum glyph_type type, { case GLYPH_BUFFER: XIMAGE_SPECIFIER_ALLOWED (g->image) = - IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK | IMAGE_MONO_PIXMAP_MASK | - IMAGE_COLOR_PIXMAP_MASK | IMAGE_SUBWINDOW_MASK; + IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK + | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK + | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK; break; case GLYPH_POINTER: XIMAGE_SPECIFIER_ALLOWED (g->image) = @@ -2825,8 +3067,8 @@ glyph_width (Lisp_Object glyph, Lisp_Object frame_face, return 0; case IMAGE_SUBWINDOW: - /* #### implement me */ - return 0; + case IMAGE_WIDGET: + return XIMAGE_INSTANCE_SUBWINDOW_WIDTH (instance); default: abort (); @@ -2929,8 +3171,12 @@ glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face, return 0; case IMAGE_SUBWINDOW: - /* #### implement me */ - return 0; + case IMAGE_WIDGET: + /* #### Ugh ugh ugh -- temporary crap */ + if (function == RETURN_ASCENT || function == RETURN_HEIGHT) + return XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (instance); + else + return 0; default: abort (); @@ -3200,36 +3446,399 @@ compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, #endif /* MEMORY_USAGE_STATS */ + /***************************************************************************** - * display tables * + * subwindow cachel functions * *****************************************************************************/ +/* subwindows are curious in that you have to physically unmap them to + not display them. It is problematic deciding what to do in + redisplay. We have two caches - a per-window instance cache that + keeps track of subwindows on a window, these are linked to their + instantiator in the hashtable and when the instantiator goes away + we want the instance to go away also. However we also have a + per-frame instance cache that we use to determine if a subwindow is + obscuring an area that we want to clear. We need to be able to flip + through this quickly so a hashtable is not suitable hence the + subwindow_cachels. The question is should we just not mark + instances in the subwindow_cachelsnor should we try and invalidate + the cache at suitable points in redisplay? If we don't invalidate + the cache it will fill up with crud that will only get removed when + the frame is deleted. So invalidation is good, the question is when + and whether we mark as well. Go for the simple option - don't mark, + MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */ -/* Get the display table for use currently on window W with face FACE. - Precedence: +void +mark_subwindow_cachels (subwindow_cachel_dynarr *elements, + void (*markobj) (Lisp_Object)) +{ + int elt; - -- FACE's display table - -- W's display table (comes from specifier `current-display-table') + if (!elements) + return; - Ignore the specified tables if they are not valid; - if no valid table is specified, return 0. */ + for (elt = 0; elt < Dynarr_length (elements); elt++) + { + struct subwindow_cachel *cachel = Dynarr_atp (elements, elt); + markobj (cachel->subwindow); + } +} -struct Lisp_Vector * -get_display_table (struct window *w, face_index findex) +static void +update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow, + struct subwindow_cachel *cachel) { - Lisp_Object tem; + if (NILP (cachel->subwindow) || !EQ (cachel->subwindow, subwindow)) + { + cachel->subwindow = subwindow; + cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow); + cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow); + } - tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex); - if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE) - return XVECTOR (tem); + cachel->updated = 1; +} - tem = w->display_table; - if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE) - return XVECTOR (tem); +static void +add_subwindow_cachel (struct frame *f, Lisp_Object subwindow) +{ + struct subwindow_cachel new_cachel; - return 0; + xzero (new_cachel); + new_cachel.subwindow = Qnil; + new_cachel.x=0; + new_cachel.y=0; + new_cachel.being_displayed=0; + + update_subwindow_cachel_data (f, subwindow, &new_cachel); + Dynarr_add (f->subwindow_cachels, new_cachel); } +static int +get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow) +{ + int elt; + + if (noninteractive) + return 0; + + for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) + { + struct subwindow_cachel *cachel = + Dynarr_atp (f->subwindow_cachels, elt); + + if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow)) + { + if (!cachel->updated) + update_subwindow_cachel_data (f, subwindow, cachel); + return elt; + } + } + + /* If we didn't find the glyph, add it and then return its index. */ + add_subwindow_cachel (f, subwindow); + return elt; +} + +void +reset_subwindow_cachels (struct frame *f) +{ + Dynarr_reset (f->subwindow_cachels); +} + +void +mark_subwindow_cachels_as_not_updated (struct frame *f) +{ + int elt; + + for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) + Dynarr_atp (f->subwindow_cachels, elt)->updated = 0; +} + + +/***************************************************************************** + * subwindow functions * + *****************************************************************************/ + +/* update the displayed characteristics of a subwindow */ +static void +update_subwindow (Lisp_Object subwindow) +{ + struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + + if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET + || + NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) + return; + + MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii)); +} + +void +update_frame_subwindows (struct frame *f) +{ + int elt; + + if (f->subwindows_changed || f->glyphs_changed) + for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) + { + struct subwindow_cachel *cachel = + Dynarr_atp (f->subwindow_cachels, elt); + + if (cachel->being_displayed) + { + update_subwindow (cachel->subwindow); + } + } +} + +/* remove a subwindow from its frame */ +void unmap_subwindow (Lisp_Object subwindow) +{ + struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + int elt; + struct subwindow_cachel* cachel; + struct frame* f; + + if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET + || + IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW) + || + NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) + return; + + f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); + elt = get_subwindow_cachel_index (f, subwindow); + cachel = Dynarr_atp (f->subwindow_cachels, elt); + + cachel->x = -1; + cachel->y = -1; + cachel->being_displayed = 0; + IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; + + MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii)); +} + +/* show a subwindow in its frame */ +void map_subwindow (Lisp_Object subwindow, int x, int y) +{ + struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + int elt; + struct subwindow_cachel* cachel; + struct frame* f; + + if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET + || + IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW) + || + NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) + return; + + f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); + IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1; + elt = get_subwindow_cachel_index (f, subwindow); + cachel = Dynarr_atp (f->subwindow_cachels, elt); + cachel->x = x; + cachel->y = y; + cachel->being_displayed = 1; + + MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y)); +} + +static int +subwindow_possible_dest_types (void) +{ + return IMAGE_SUBWINDOW_MASK; +} + +/* Partially instantiate a subwindow. */ +void +subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + 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); + Lisp_Object frame = FW_FRAME (domain); + Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width); + Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height); + + if (NILP (frame)) + signal_simple_error ("No selected frame", device); + + if (!(dest_mask & IMAGE_SUBWINDOW_MASK)) + incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK); + + ii->data = 0; + IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0; + IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = Qnil; + IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; + IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame; + + /* this stuff may get overidden by the widget code */ + if (NILP (width)) + IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20; + else + { + int w = 1; + CHECK_INT (width); + if (XINT (width) > 1) + w = XINT (width); + IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w; + } + if (NILP (height)) + IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20; + else + { + int h = 1; + CHECK_INT (height); + if (XINT (height) > 1) + h = XINT (height); + IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h; + } +} + +DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /* +Return non-nil if OBJECT is a subwindow. +*/ + (object)) +{ + CHECK_IMAGE_INSTANCE (object); + return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil; +} + +DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /* +Return the window id of SUBWINDOW as a number. +*/ + (subwindow)) +{ + CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); + return make_int ((int) (XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow))); +} + +DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /* +Resize SUBWINDOW to WIDTH x HEIGHT. +If a value is nil that parameter is not changed. +*/ + (subwindow, width, height)) +{ + int neww, newh; + + CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); + + if (NILP (width)) + neww = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow); + else + neww = XINT (width); + + if (NILP (height)) + newh = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow); + else + newh = XINT (height); + + + MAYBE_DEVMETH (XDEVICE (XIMAGE_INSTANCE_DEVICE (subwindow)), + resize_subwindow, (XIMAGE_INSTANCE (subwindow), neww, newh)); + + XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow) = newh; + XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow) = neww; + + return subwindow; +} + +DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /* +Generate a Map event for SUBWINDOW. +*/ + (subwindow)) +{ + CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); + + map_subwindow (subwindow, 0, 0); + + return subwindow; +} + + +/***************************************************************************** + * display tables * + *****************************************************************************/ + +/* Get the display tables for use currently on window W with face + FACE. #### This will have to be redone. */ + +void +get_display_tables (struct window *w, face_index findex, + Lisp_Object *face_table, Lisp_Object *window_table) +{ + Lisp_Object tem; + tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex); + if (UNBOUNDP (tem)) + tem = Qnil; + if (!LISTP (tem)) + tem = noseeum_cons (tem, Qnil); + *face_table = tem; + tem = w->display_table; + if (UNBOUNDP (tem)) + tem = Qnil; + if (!LISTP (tem)) + tem = noseeum_cons (tem, Qnil); + *window_table = tem; +} + +Lisp_Object +display_table_entry (Emchar ch, Lisp_Object face_table, + Lisp_Object window_table) +{ + Lisp_Object tail; + + /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */ + for (tail = face_table; 1; tail = XCDR (tail)) + { + Lisp_Object table; + if (NILP (tail)) + { + if (!NILP (window_table)) + { + tail = window_table; + window_table = Qnil; + } + else + return Qnil; + } + table = XCAR (tail); + + if (VECTORP (table)) + { + if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch])) + return XVECTOR_DATA (table)[ch]; + else + continue; + } + else if (CHAR_TABLEP (table) + && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR) + { + return get_char_table (ch, XCHAR_TABLE (table)); + } + else if (CHAR_TABLEP (table) + && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC) + { + Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table)); + if (!NILP (gotit)) + return gotit; + else + continue; + } + else if (RANGE_TABLEP (table)) + { + Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil); + if (!NILP (gotit)) + return gotit; + else + continue; + } + else + abort (); + } +} /***************************************************************************** * initialization * @@ -3248,6 +3857,8 @@ syms_of_glyphs (void) defkeyword (&Q_file, ":file"); defkeyword (&Q_data, ":data"); defkeyword (&Q_face, ":face"); + defkeyword (&Q_pixel_height, ":pixel-height"); + defkeyword (&Q_pixel_width, ":pixel-width"); #ifdef HAVE_XPM defkeyword (&Q_color_symbols, ":color-symbols"); @@ -3274,6 +3885,7 @@ syms_of_glyphs (void) defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p"); defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p"); defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p"); + defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p"); defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p"); DEFSUBR (Fmake_image_instance); @@ -3292,7 +3904,14 @@ syms_of_glyphs (void) DEFSUBR (Fimage_instance_hotspot_y); DEFSUBR (Fimage_instance_foreground); DEFSUBR (Fimage_instance_background); + DEFSUBR (Fimage_instance_property); + DEFSUBR (Fset_image_instance_property); DEFSUBR (Fcolorize_image_instance); + /* subwindows */ + DEFSUBR (Fsubwindowp); + DEFSUBR (Fimage_instance_subwindow_id); + DEFSUBR (Fresize_subwindow); + DEFSUBR (Fforce_subwindow_map); /* Qnothing defined as part of the "nothing" image-instantiator type. */ @@ -3300,7 +3919,6 @@ syms_of_glyphs (void) defsymbol (&Qmono_pixmap, "mono-pixmap"); defsymbol (&Qcolor_pixmap, "color-pixmap"); /* Qpointer defined in general.c */ - defsymbol (&Qsubwindow, "subwindow"); /* glyphs */ @@ -3390,13 +4008,19 @@ image_instantiator_format_create (void) IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string); + /* subwindows */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow"); + IIFORMAT_HAS_METHOD (subwindow, possible_dest_types); + IIFORMAT_HAS_METHOD (subwindow, instantiate); + IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int); + #ifdef HAVE_WINDOW_SYSTEM INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm"); IIFORMAT_HAS_METHOD (xbm, validate); IIFORMAT_HAS_METHOD (xbm, normalize); IIFORMAT_HAS_METHOD (xbm, possible_dest_types); - IIFORMAT_HAS_METHOD (xbm, instantiate); IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline); IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string); @@ -3414,7 +4038,6 @@ image_instantiator_format_create (void) IIFORMAT_HAS_METHOD (xpm, validate); IIFORMAT_HAS_METHOD (xpm, normalize); IIFORMAT_HAS_METHOD (xpm, possible_dest_types); - IIFORMAT_HAS_METHOD (xpm, instantiate); IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string); IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string); @@ -3430,8 +4053,9 @@ vars_of_glyphs (void) /* image instances */ - Vimage_instance_type_list = list6 (Qnothing, Qtext, Qmono_pixmap, - Qcolor_pixmap, Qpointer, Qsubwindow); + Vimage_instance_type_list = Fcons (Qnothing, + list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, + Qpointer, Qsubwindow, Qwidget)); staticpro (&Vimage_instance_type_list); /* glyphs */ @@ -3467,7 +4091,9 @@ Normally this is three dots ("..."). What to display at the beginning of horizontally scrolled lines. */); Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); - +#ifdef HAVE_WINDOW_SYSTEM + Fprovide (Qxbm); +#endif #ifdef HAVE_XPM Fprovide (Qxpm); diff --git a/src/glyphs.h b/src/glyphs.h index 0d49521..97d825e 100644 --- a/src/glyphs.h +++ b/src/glyphs.h @@ -25,6 +25,7 @@ Boston, MA 02111-1307, USA. */ #define _XEMACS_GLYPHS_H_ #include "specifier.h" +#include "gui.h" /************************************************************************/ /* Image Instantiators */ @@ -47,11 +48,18 @@ struct image_instantiator_methods; jpeg color-pixmap png color-pixmap tiff color-pixmap + bmp color-pixmap cursor-font pointer + mswindows-resource pointer font pointer subwindow subwindow inherit mono-pixmap autodetect mono-pixmap, color-pixmap, pointer, text + button widget + edit widget + combo widget + scrollbar widget + static widget */ /* These are methods specific to a particular format of image instantiator @@ -74,6 +82,8 @@ struct image_instantiator_methods { Lisp_Object symbol; + Lisp_Object device; /* sometimes used */ + ii_keyword_entry_dynarr *keywords; /* Implementation specific methods: */ @@ -104,6 +114,15 @@ struct image_instantiator_methods Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain); + /* Property method: Given an image instance, return device specific + properties. */ + Lisp_Object (*property_method) (Lisp_Object image_instance, + Lisp_Object property); + /* Set-property method: Given an image instance, set device specific + properties. */ + Lisp_Object (*set_property_method) (Lisp_Object image_instance, + Lisp_Object property, + Lisp_Object val); }; /***** Calling an image-instantiator method *****/ @@ -112,12 +131,22 @@ struct image_instantiator_methods #define IIFORMAT_METH(mstruc, m, args) (((mstruc)->m##_method) args) /* Call a void-returning specifier method, if it exists */ -#define MAYBE_IIFORMAT_METH(mstruc, m, args) do { \ - struct image_instantiator_methods *maybe_iiformat_meth_mstruc = (mstruc); \ - if (HAS_IIFORMAT_METH_P (maybe_iiformat_meth_mstruc, m)) \ - IIFORMAT_METH (maybe_iiformat_meth_mstruc, m, args); \ +#define MAYBE_IIFORMAT_METH(mstruc, m, args) \ +if (mstruc) \ +do { \ + struct image_instantiator_methods *maybe_iiformat_meth_mstruc = (mstruc); \ + if (HAS_IIFORMAT_METH_P (maybe_iiformat_meth_mstruc, m)) \ + IIFORMAT_METH (maybe_iiformat_meth_mstruc, m, args); \ +} while (0) + +#define MAYBE_IIFORMAT_DEVMETH(device, mstruc, m, args) \ +do { \ + struct image_instantiator_methods *_mstruc = decode_ii_device (device, mstruc); \ + if (_mstruc) \ + MAYBE_IIFORMAT_METH(_mstruc, m, args); \ } while (0) + /* Call a specifier method, if it exists; otherwise return the specified value */ @@ -133,23 +162,32 @@ extern struct image_instantiator_methods *format##_image_instantiator_methods #define DEFINE_IMAGE_INSTANTIATOR_FORMAT(format) \ struct image_instantiator_methods *format##_image_instantiator_methods -#define INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(format, obj_name) \ +#define INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM(format, obj_name) \ do { \ format##_image_instantiator_methods = \ xnew_and_zero (struct image_instantiator_methods); \ - defsymbol (&Q##format, obj_name); \ format##_image_instantiator_methods->symbol = Q##format; \ + format##_image_instantiator_methods->device = Qnil; \ format##_image_instantiator_methods->keywords = \ Dynarr_new (ii_keyword_entry); \ add_entry_to_image_instantiator_format_list \ (Q##format, format##_image_instantiator_methods); \ } while (0) +#define INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(format, obj_name) \ +do { \ + defsymbol (&Q##format, obj_name); \ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM(format, obj_name); \ +} while (0) + /* Declare that image-instantiator format FORMAT has method M; used in initialization routines */ #define IIFORMAT_HAS_METHOD(format, m) \ (format##_image_instantiator_methods->m##_method = format##_##m) +#define IIFORMAT_HAS_SHARED_METHOD(format, m, type) \ + (format##_image_instantiator_methods->m##_method = type##_##m) + /* Declare that KEYW is a valid keyword for image-instantiator format FORMAT. VALIDATE_FUN if a function that returns whether the data is valid. The keyword may not appear more than once. */ @@ -177,8 +215,36 @@ do { \ entry); \ } while (0) +#define DEFINE_DEVICE_IIFORMAT(type, format)\ +struct image_instantiator_methods *type##_##format##_image_instantiator_methods + +#define INITIALIZE_DEVICE_IIFORMAT(type, format) \ +do { \ + type##_##format##_image_instantiator_methods = \ + xnew_and_zero (struct image_instantiator_methods); \ + type##_##format##_image_instantiator_methods->symbol = Q##format; \ + type##_##format##_image_instantiator_methods->device = Q##type; \ + type##_##format##_image_instantiator_methods->keywords = \ + Dynarr_new (ii_keyword_entry); \ + add_entry_to_device_ii_format_list \ + (Q##type, Q##format, type##_##format##_image_instantiator_methods); \ +} while (0) + +/* Declare that image-instantiator format FORMAT has method M; used in + initialization routines */ +#define IIFORMAT_HAS_DEVMETHOD(type, format, m) \ + (type##_##format##_image_instantiator_methods->m##_method = type##_##format##_##m) + +struct image_instantiator_methods * +decode_device_ii_format (Lisp_Object device, Lisp_Object format, + Error_behavior errb); +struct image_instantiator_methods * +decode_image_instantiator_format (Lisp_Object format, Error_behavior errb); + void add_entry_to_image_instantiator_format_list (Lisp_Object symbol, struct image_instantiator_methods *meths); +void add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol, + struct image_instantiator_methods *meths); Lisp_Object find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword); Lisp_Object find_keyword_in_vector_or_given (Lisp_Object vector, @@ -193,6 +259,14 @@ Lisp_Object potential_pixmap_file_instantiator (Lisp_Object instantiator, Lisp_Object console_type); void check_valid_string (Lisp_Object data); void check_valid_int (Lisp_Object data); +void check_valid_face (Lisp_Object data); +void check_valid_vector (Lisp_Object data); + +void initialize_subwindow_image_instance (struct Lisp_Image_Instance*); +void subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain); + DECLARE_DOESNT_RETURN (incompatible_image_types (Lisp_Object instantiator, int given_dest_mask, int desired_dest_mask)); @@ -250,7 +324,8 @@ enum image_instance_type IMAGE_MONO_PIXMAP, IMAGE_COLOR_PIXMAP, IMAGE_POINTER, - IMAGE_SUBWINDOW + IMAGE_SUBWINDOW, + IMAGE_WIDGET }; #define IMAGE_NOTHING_MASK (1 << 0) @@ -259,6 +334,7 @@ enum image_instance_type #define IMAGE_COLOR_PIXMAP_MASK (1 << 3) #define IMAGE_POINTER_MASK (1 << 4) #define IMAGE_SUBWINDOW_MASK (1 << 5) +#define IMAGE_WIDGET_MASK (1 << 6) #define IMAGE_INSTANCE_TYPE_P(ii, type) \ (IMAGE_INSTANCEP (ii) && XIMAGE_INSTANCE_TYPE (ii) == type) @@ -275,6 +351,8 @@ enum image_instance_type IMAGE_INSTANCE_TYPE_P (ii, IMAGE_POINTER) #define SUBWINDOW_IMAGE_INSTANCEP(ii) \ IMAGE_INSTANCE_TYPE_P (ii, IMAGE_SUBWINDOW) +#define WIDGET_IMAGE_INSTANCEP(ii) \ + IMAGE_INSTANCE_TYPE_P (ii, IMAGE_WIDGET) #define CHECK_NOTHING_IMAGE_INSTANCE(x) do { \ CHECK_IMAGE_INSTANCE (x); \ @@ -308,10 +386,17 @@ enum image_instance_type #define CHECK_SUBWINDOW_IMAGE_INSTANCE(x) do { \ CHECK_IMAGE_INSTANCE (x); \ - if (!SUBWINDOW_IMAGE_INSTANCEP (x)) \ + if (!SUBWINDOW_IMAGE_INSTANCEP (x) \ + && !WIDGET_IMAGE_INSTANCEP (x)) \ x = wrong_type_argument (Qsubwindow_image_instance_p, (x)); \ } while (0) +#define CHECK_WIDGET_IMAGE_INSTANCE(x) do { \ + CHECK_IMAGE_INSTANCE (x); \ + if (!WIDGET_IMAGE_INSTANCEP (x)) \ + x = wrong_type_argument (Qwidget_image_instance_p, (x)); \ +} while (0) + struct Lisp_Image_Instance { struct lcrecord_header header; @@ -338,7 +423,17 @@ struct Lisp_Image_Instance } pixmap; /* used for pointers as well */ struct { - int dummy; /* #### fill in this structure */ + Lisp_Object frame; + unsigned int width, height; + void* subwindow; /* specific devices can use this as necessary */ + int being_displayed; /* used to detect when needs to be unmapped */ + struct + { + Lisp_Object face; /* foreground and background colors */ + Lisp_Object type; + Lisp_Object props; /* properties */ + struct gui_item gui_item; + } widget; /* widgets are subwindows */ } subwindow; } u; @@ -366,6 +461,25 @@ struct Lisp_Image_Instance #define IMAGE_INSTANCE_PIXMAP_BG(i) ((i)->u.pixmap.bg) #define IMAGE_INSTANCE_PIXMAP_AUXDATA(i) ((i)->u.pixmap.auxdata) +#define IMAGE_INSTANCE_SUBWINDOW_WIDTH(i) ((i)->u.subwindow.width) +#define IMAGE_INSTANCE_SUBWINDOW_HEIGHT(i) ((i)->u.subwindow.height) +#define IMAGE_INSTANCE_SUBWINDOW_ID(i) ((i)->u.subwindow.subwindow) +#define IMAGE_INSTANCE_SUBWINDOW_FRAME(i) ((i)->u.subwindow.frame) +#define IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP(i) \ +((i)->u.subwindow.being_displayed) + +#define IMAGE_INSTANCE_WIDGET_WIDTH(i) \ + IMAGE_INSTANCE_SUBWINDOW_WIDTH(i) +#define IMAGE_INSTANCE_WIDGET_HEIGHT(i) \ + IMAGE_INSTANCE_SUBWINDOW_HEIGHT(i) +#define IMAGE_INSTANCE_WIDGET_CALLBACK(i) \ + ((i)->u.subwindow.widget.gui_item.callback) +#define IMAGE_INSTANCE_WIDGET_TYPE(i) ((i)->u.subwindow.widget.type) +#define IMAGE_INSTANCE_WIDGET_PROPS(i) ((i)->u.subwindow.widget.props) +#define IMAGE_INSTANCE_WIDGET_FACE(i) ((i)->u.subwindow.widget.face) +#define IMAGE_INSTANCE_WIDGET_TEXT(i) ((i)->u.subwindow.widget.gui_item.name) +#define IMAGE_INSTANCE_WIDGET_ITEM(i) ((i)->u.subwindow.widget.gui_item) + #define XIMAGE_INSTANCE_DEVICE(i) \ IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_NAME(i) \ @@ -395,6 +509,34 @@ struct Lisp_Image_Instance #define XIMAGE_INSTANCE_PIXMAP_BG(i) \ IMAGE_INSTANCE_PIXMAP_BG (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_WIDTH(i) \ + IMAGE_INSTANCE_WIDGET_WIDTH (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_HEIGHT(i) \ + IMAGE_INSTANCE_WIDGET_HEIGHT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_CALLBACK(i) \ + IMAGE_INSTANCE_WIDGET_CALLBACK (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_TYPE(i) \ + IMAGE_INSTANCE_WIDGET_TYPE (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_PROPS(i) \ + IMAGE_INSTANCE_WIDGET_PROPS (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_FACE(i) \ + IMAGE_INSTANCE_WIDGET_FACE (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_TEXT(i) \ + IMAGE_INSTANCE_WIDGET_TEXT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_ITEM(i) \ + IMAGE_INSTANCE_WIDGET_ITEM (XIMAGE_INSTANCE (i)) + +#define XIMAGE_INSTANCE_SUBWINDOW_WIDTH(i) \ + IMAGE_INSTANCE_SUBWINDOW_WIDTH (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBWINDOW_HEIGHT(i) \ + IMAGE_INSTANCE_SUBWINDOW_HEIGHT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBWINDOW_ID(i) \ + IMAGE_INSTANCE_SUBWINDOW_ID (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBWINDOW_FRAME(i) \ + IMAGE_INSTANCE_SUBWINDOW_FRAME (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP(i) \ + IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (XIMAGE_INSTANCE (i)) + #ifdef HAVE_XPM Lisp_Object evaluate_xpm_color_symbols (void); Lisp_Object pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid); @@ -480,10 +622,11 @@ DECLARE_LRECORD (glyph, struct Lisp_Glyph); extern Lisp_Object Qxpm; extern Lisp_Object Q_data, Q_file, Q_color_symbols, Qconst_glyph_variable; -extern Lisp_Object Qxbm; +extern Lisp_Object Qxbm, Qedit, Qgroup, Qlabel, Qcombo, Qscrollbar; extern Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y; -extern Lisp_Object Q_foreground, Q_background; -extern Lisp_Object Qimage_conversion_error; +extern Lisp_Object Q_foreground, Q_background, Q_face, Q_descriptor, Q_group; +extern Lisp_Object Q_width, Q_height, Q_pixel_width, Q_pixel_height; +extern Lisp_Object Q_items, Q_properties, Qimage_conversion_error; extern Lisp_Object Vcontinuation_glyph, Vcontrol_arrow_glyph, Vhscroll_glyph; extern Lisp_Object Vinvisible_text_glyph, Voctal_escape_glyph, Vtruncation_glyph; extern Lisp_Object Vxemacs_logo; @@ -519,6 +662,11 @@ Lisp_Object allocate_glyph (enum glyph_type type, void (*after_change) (Lisp_Object glyph, Lisp_Object property, Lisp_Object locale)); +Lisp_Object widget_face_font_info (Lisp_Object domain, Lisp_Object face, + int *height, int *width); +void widget_text_to_pixel_conversion (Lisp_Object domain, Lisp_Object face, + int th, int tw, + int* height, int* width); /************************************************************************/ /* Glyph Cachels */ @@ -557,6 +705,7 @@ void mark_glyph_cachels (glyph_cachel_dynarr *elements, void (*markobj) (Lisp_Object)); void mark_glyph_cachels_as_not_updated (struct window *w); void reset_glyph_cachels (struct window *w); + #ifdef MEMORY_USAGE_STATS int compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, struct overhead_stats *ovstats); @@ -566,9 +715,37 @@ int compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, /* Display Tables */ /************************************************************************/ -#define DISP_TABLE_SIZE 256 -#define DISP_CHAR_ENTRY(dp, c) ((c < (dp)->size) ? (dp)->contents[c] : Qnil) +Lisp_Object display_table_entry (Emchar, Lisp_Object, Lisp_Object); +void get_display_tables (struct window *, face_index, + Lisp_Object *, Lisp_Object *); + +/**************************************************************************** + * Subwindow Object * + ****************************************************************************/ + +/* redisplay needs a per-frame cache of subwindows being displayed so + * that we known when to unmap them */ +typedef struct subwindow_cachel subwindow_cachel; +struct subwindow_cachel +{ + Lisp_Object subwindow; + int x, y; + int width, height; + int being_displayed; + int updated; +}; -struct Lisp_Vector *get_display_table (struct window *, face_index); +typedef struct +{ + Dynarr_declare (subwindow_cachel); +} subwindow_cachel_dynarr; + +void mark_subwindow_cachels (subwindow_cachel_dynarr *elements, + void (*markobj) (Lisp_Object)); +void mark_subwindow_cachels_as_not_updated (struct frame *f); +void reset_subwindow_cachels (struct frame *f); +void unmap_subwindow (Lisp_Object subwindow); +void map_subwindow (Lisp_Object subwindow, int x, int y); +void update_frame_subwindows (struct frame *f); #endif /* _XEMACS_GLYPHS_H_ */ diff --git a/src/gui-msw.c b/src/gui-msw.c new file mode 100644 index 0000000..e02712f --- /dev/null +++ b/src/gui-msw.c @@ -0,0 +1,57 @@ +/* mswindows GUI code. (menubars, scrollbars, toolbars, dialogs) + Copyright (C) 1998 Andy Piper. + +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. */ + +#include +#include "lisp.h" +#include "gui.h" +#include "redisplay.h" +#include "frame.h" +#include "elhash.h" +#include "console-msw.h" + +/* + * Return value is Qt if we have dispatched the command, + * or Qnil if id has not been mapped to a callback. + * Window procedure may try other targets to route the + * command if we return nil + */ +Lisp_Object +mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, WORD id) +{ + /* Try to map the command id through the proper hash table */ + Lisp_Object data, fn, arg, frame; + + data = Fgethash (make_int (id), + FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), Qnil); + + if (NILP (data) || UNBOUNDP (data)) + return Qnil; + + MARK_SUBWINDOWS_CHANGED; + /* Ok, this is our one. Enqueue it. */ + get_gui_callback (data, &fn, &arg); + XSETFRAME (frame, f); + mswindows_enqueue_misc_user_event (frame, fn, arg); + + return Qt; +} + diff --git a/src/gui.c b/src/gui.c index de78ca0..bcd5e1b 100644 --- a/src/gui.c +++ b/src/gui.c @@ -26,6 +26,7 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" #include "gui.h" +#include "elhash.h" #include "bytecode.h" Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; @@ -46,6 +47,7 @@ See `popup-menu' and `popup-dialog-box'. { return popup_up_p ? Qt : Qnil; } +#endif /* HAVE_POPUPS */ int separator_string_p (CONST char *s) @@ -148,26 +150,36 @@ gui_item_add_keyval_pair (struct gui_item *pgui_item, void gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item) { - int length, plist_p; + int length, plist_p, start; Lisp_Object *contents; CHECK_VECTOR (item); length = XVECTOR_LENGTH (item); contents = XVECTOR_DATA (item); - if (length < 2) - signal_simple_error ("GUI item descriptors must be at least 2 elts long", item); + if (length < 1) + signal_simple_error ("GUI item descriptors must be at least 1 elts long", item); - /* length 2: [ "name" callback ] + /* length 1: [ "name" ] + length 2: [ "name" callback ] length 3: [ "name" callback active-p ] + or [ "name" keyword value ] length 4: [ "name" callback active-p suffix ] or [ "name" callback keyword value ] length 5+: [ "name" callback [ keyword value ]+ ] + or [ "name" [ keyword value ]+ ] */ - plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2]))); + plist_p = (length > 2 && (KEYWORDP (contents [1]) + || KEYWORDP (contents [2]))); pgui_item->name = contents [0]; - pgui_item->callback = contents [1]; + if (length > 1 && !KEYWORDP (contents [1])) + { + pgui_item->callback = contents [1]; + start = 2; + } + else + start =1; if (!plist_p && length > 2) /* the old way */ @@ -180,12 +192,12 @@ gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item) /* the new way */ { int i; - if (length & 1) + if ((length - start) & 1) signal_simple_error ( "GUI item descriptor has an odd number of keywords and values", item); - for (i = 2; i < length;) + for (i = start; i < length;) { Lisp_Object key = contents [i++]; Lisp_Object val = contents [i++]; @@ -209,6 +221,20 @@ gui_item_active_p (CONST struct gui_item *pgui_item) } /* + * Decide whether a GUI item is selected by evaluating its :selected form + * if any + */ +int +gui_item_selected_p (CONST struct gui_item *pgui_item) +{ + /* This function can call lisp */ + + /* Shortcut to avoid evaluating Qt each time */ + return (EQ (pgui_item->selected, Qt) + || !NILP (Feval (pgui_item->selected))); +} + +/* * Decide whether a GUI item is included by evaluating its :included * form if given, and testing its :config form against supplied CONFLIST * configuration variable @@ -237,6 +263,7 @@ signal_too_long_error (Lisp_Object name) signal_simple_error ("GUI item produces too long displayable string", name); } +#ifdef HAVE_WINDOW_SYSTEM /* * Format "left flush" display portion of an item into BUF, guarded by * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating @@ -330,8 +357,37 @@ gui_item_display_flush_right (CONST struct gui_item *pgui_item, /* No keys - no right flush display */ return 0; } +#endif /* HAVE_WINDOW_SYSTEM */ -#endif /* HAVE_POPUPS */ +Lisp_Object +mark_gui_item (struct gui_item* p, void (*markobj) (Lisp_Object)) +{ + markobj (p->name); + markobj (p->callback); + markobj (p->suffix); + markobj (p->active); + markobj (p->included); + markobj (p->config); + markobj (p->filter); + markobj (p->style); + markobj (p->selected); + markobj (p->keys); + + return Qnil; +} + +int +gui_item_hash (Lisp_Object hashtable, struct gui_item* g, int slot) +{ + int hashid = HASH2 (internal_hash (g->callback, 0), internal_hash (g->name, 0)); + int id = GUI_ITEM_ID_BITS (hashid, slot); + while (!NILP (Fgethash (make_int (id), + hashtable, Qnil))) + { + id = GUI_ITEM_ID_BITS (id + 1, slot); + } + return id; +} void syms_of_gui (void) diff --git a/src/gui.h b/src/gui.h index ab80f52..d65f1f8 100644 --- a/src/gui.h +++ b/src/gui.h @@ -27,7 +27,6 @@ Boston, MA 02111-1307, USA. */ #ifndef _XEMACS_GUI_H_ #define _XEMACS_GUI_H_ -#ifdef HAVE_POPUPS int separator_string_p (CONST char *s); void get_gui_callback (Lisp_Object, Lisp_Object *, Lisp_Object *); @@ -76,12 +75,19 @@ void gui_item_add_keyval_pair (struct gui_item *pgui_item, Lisp_Object key, Lisp_Object val); void gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item); int gui_item_active_p (CONST struct gui_item *pgui_item); +int gui_item_selected_p (CONST struct gui_item *pgui_item); int gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object into); +int gui_item_hash (Lisp_Object, struct gui_item*, int); +Lisp_Object mark_gui_item (struct gui_item* p, void (*markobj) (Lisp_Object)); unsigned int gui_item_display_flush_left (CONST struct gui_item *pgui_item, char* buf, Bytecount buf_len); unsigned int gui_item_display_flush_right (CONST struct gui_item *pgui_item, char* buf, Bytecount buf_len); -#endif /* HAVE_POPUPS */ +/* this is mswindows biased but reasonably safe I think */ +#define GUI_ITEM_ID_SLOTS 8 +#define GUI_ITEM_ID_MIN(s) (s * 0x2000) +#define GUI_ITEM_ID_MAX(s) (0x1FFF + GUI_ITEM_ID_MIN (s)) +#define GUI_ITEM_ID_BITS(x,s) (((x) & 0x1FFF) + GUI_ITEM_ID_MIN (s)) #endif /* _XEMACS_GUI_H_ */ diff --git a/src/lisp.h b/src/lisp.h index 8fed55f..4313a5b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2868,6 +2868,7 @@ EXFUN (Fold_equal, 2); EXFUN (Fold_member, 2); EXFUN (Fold_memq, 2); EXFUN (Fplist_get, 3); +EXFUN (Fplist_member, 2); EXFUN (Fplist_put, 3); EXFUN (Fplus, MANY); EXFUN (Fpoint, 1); @@ -3000,11 +3001,11 @@ extern Lisp_Object Qquote, Qrange_error, Qrassoc, Qrassq, Qread_char; extern Lisp_Object Qread_from_minibuffer, Qreally_early_error_handler; extern Lisp_Object Qregion_beginning, Qregion_end, Qrequire, Qresource; extern Lisp_Object Qreturn, Qreverse, Qright, Qrun_hooks, Qsans_modifiers; -extern Lisp_Object Qsave_buffers_kill_emacs, Qsearch, Qself_insert_command; +extern Lisp_Object Qsave_buffers_kill_emacs, Qsearch, Qselected, Qself_insert_command; extern Lisp_Object Qsequencep, Qsetting_constant, Qseven, Qshift_jis, Qshort; extern Lisp_Object Qsignal, Qsimple, Qsingularity_error, Qsize, Qspace; extern Lisp_Object Qspecifier, Qstandard_input, Qstandard_output, Qstart_open; -extern Lisp_Object Qstream, Qstring, Qstring_lessp; +extern Lisp_Object Qstream, Qstring, Qstring_lessp, Qsubwindow; extern Lisp_Object Qsubwindow_image_instance_p, Qsymbol, Qsyntax, Qt, Qtest; extern Lisp_Object Qtext, Qtext_image_instance_p, Qtimeout, Qtimestamp; extern Lisp_Object Qtoolbar, Qtop, Qtop_level, Qtrue_list_p, Qtty, Qtype; @@ -3012,7 +3013,7 @@ extern Lisp_Object Qunbound, Qundecided, Qundefined, Qunderflow_error; extern Lisp_Object Qunderline, Qunimplemented, Quser_files_and_directories; extern Lisp_Object Qvalue_assoc, Qvalues; extern Lisp_Object Qvariable_documentation, Qvariable_domain, Qvector; -extern Lisp_Object Qvoid_function, Qvoid_variable, Qwarning, Qwidth, Qwindow; +extern Lisp_Object Qvoid_function, Qvoid_variable, Qwarning, Qwidth, Qwidget, Qwindow; extern Lisp_Object Qwindow_live_p, Qwindow_system, Qwrong_number_of_arguments; extern Lisp_Object Qwrong_type_argument, Qx, Qy, Qyes_or_no_p; extern Lisp_Object Vactivate_menubar_hook, Vascii_canon_table; diff --git a/src/menubar-msw.c b/src/menubar-msw.c index 0c8eaf7..ff707cb 100644 --- a/src/menubar-msw.c +++ b/src/menubar-msw.c @@ -130,11 +130,37 @@ displayable_menu_item (struct gui_item* pgui_item, int bar_p) and better be caught than displayed! */ static char buf[MAX_MENUITEM_LENGTH+2]; + char *ptr; unsigned int ll, lr; /* Left flush part of the string */ ll = gui_item_display_flush_left (pgui_item, buf, MAX_MENUITEM_LENGTH); + /* Escape '&' as '&&' */ + ptr = buf; + while ((ptr=memchr (ptr, '&', ll-(ptr-buf))) != NULL) + { + if (ll+2 >= MAX_MENUITEM_LENGTH) + signal_simple_error ("Menu item produces too long displayable string", + pgui_item->name); + memmove (ptr+1, ptr, ll-(ptr-buf)); + ll++; + ptr+=2; + } + + /* Replace XEmacs accelerator '%_' with Windows accelerator '&' */ + ptr = buf; + while ((ptr=memchr (ptr, '%', ll-(ptr-buf))) != NULL) + { + if (*(ptr+1) == '_') + { + *ptr = '&'; + memmove (ptr+1, ptr+2, ll-(ptr-buf+2)); + ll--; + } + ptr++; + } + /* Right flush part, unless we're at the top-level where it's not allowed */ if (!bar_p) { diff --git a/src/menubar-x.c b/src/menubar-x.c index f9c5349..36c1344 100644 --- a/src/menubar-x.c +++ b/src/menubar-x.c @@ -122,6 +122,11 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, { wv->name = string_chars; wv->enabled = 1; + /* dverna Dec. 98: command_builder_operate_menu_accelerator will + manipulate the accel as a Lisp_Object if the widget has a name. + Since simple labels have a name, but no accel, we *must* set it + to nil */ + wv->accel = LISP_TO_VOID (Qnil); } } else if (VECTORP (desc)) diff --git a/src/redisplay-msw.c b/src/redisplay-msw.c index 8c77725..304900c 100644 --- a/src/redisplay-msw.c +++ b/src/redisplay-msw.c @@ -58,8 +58,6 @@ Boston, MA 02111-1307, USA. */ */ static void mswindows_update_dc (HDC hdc, Lisp_Object font, Lisp_Object fg, Lisp_Object bg, Lisp_Object bg_pmap); -static void mswindows_clear_region (Lisp_Object locale, face_index findex, - int x, int y, int width, int height); static void mswindows_output_vertical_divider (struct window *w, int clear); static void mswindows_redraw_exposed_windows (Lisp_Object window, int x, int y, int width, int height); @@ -351,7 +349,7 @@ mswindows_output_cursor (struct window *w, struct display_line *dl, int xpos, { struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); - struct face_cachel *cachel; + struct face_cachel *cachel=0; Lisp_Object font = Qnil; int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); HDC hdc = FRAME_MSWINDOWS_DC (f); @@ -555,7 +553,7 @@ mswindows_output_string (struct window *w, struct display_line *dl, int clear_end = min (xpos + this_width, clip_end); { - mswindows_clear_region (window, findex, clear_start, + redisplay_clear_region (window, findex, clear_start, dl->ypos - dl->ascent, clear_end - clear_start, height); @@ -794,7 +792,7 @@ mswindows_output_pixmap (struct window *w, struct display_line *dl, } if (!offset_bitmap) /* i.e. not a bg pixmap */ - mswindows_clear_region (window, findex, clear_x, clear_y, + redisplay_clear_region (window, findex, clear_x, clear_y, clear_width, clear_height); } @@ -1181,7 +1179,7 @@ mswindows_output_display_block (struct window *w, struct display_line *dl, int b /* Clear in case a cursor was formerly here. */ int height = dl->ascent + dl->descent - dl->clip; - mswindows_clear_region (window, findex, xpos, dl->ypos - dl->ascent, + redisplay_clear_region (window, findex, xpos, dl->ypos - dl->ascent, rb->width, height); elt++; } @@ -1262,7 +1260,14 @@ mswindows_output_display_block (struct window *w, struct display_line *dl, int b abort (); case IMAGE_SUBWINDOW: - /* #### implement me */ + case IMAGE_WIDGET: + redisplay_output_subwindow (w, dl, instance, xpos, + rb->object.dglyph.xoffset, start_pixpos, + rb->width, findex, cursor_start, + cursor_width, cursor_height); + if (rb->cursor_type == CURSOR_ON) + mswindows_output_cursor (w, dl, xpos, cursor_width, + findex, 0, 1); break; case IMAGE_NOTHING: @@ -1386,69 +1391,15 @@ mswindows_text_width (struct frame *f, struct face_cachel *cachel, given face. ****************************************************************************/ static void -mswindows_clear_region (Lisp_Object locale, face_index findex, int x, int y, - int width, int height) +mswindows_clear_region (Lisp_Object locale, struct device* d, struct frame* f, + face_index findex, int x, int y, + int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, + Lisp_Object background_pixmap) { - struct window *w; - struct frame *f; - Lisp_Object background_pixmap = Qunbound; - Lisp_Object temp; RECT rect = { x, y, x+width, y+height }; - if (!(width && height)) /* We often seem to get called with width==0 */ - return; - - if (WINDOWP (locale)) - { - w = XWINDOW (locale); - f = XFRAME (w->frame); - } - else if (FRAMEP (locale)) + if (!NILP (background_pixmap)) { - w = NULL; - f = XFRAME (locale); - } - else - abort (); - - if (w) - { - temp = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, findex); - - if (IMAGE_INSTANCEP (temp) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) - { - /* #### maybe we could implement such that a string - can be a background pixmap? */ - background_pixmap = temp; - } - } - else - { - temp = FACE_BACKGROUND_PIXMAP (Vdefault_face, locale); - - if (IMAGE_INSTANCEP (temp) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) - { - background_pixmap = temp; - } - } - - if (!UNBOUNDP (background_pixmap)) - { - Lisp_Object fcolor, bcolor; - - if (w) - { - fcolor = WINDOW_FACE_CACHEL_FOREGROUND (w, findex); - bcolor = WINDOW_FACE_CACHEL_BACKGROUND (w, findex); - } - else - { - fcolor = FACE_FOREGROUND (Vdefault_face, locale); - bcolor = FACE_BACKGROUND (Vdefault_face, locale); - } - mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, fcolor, bcolor, background_pixmap); @@ -1458,15 +1409,14 @@ mswindows_clear_region (Lisp_Object locale, face_index findex, int x, int y, } else { - Lisp_Object color = (w ? WINDOW_FACE_CACHEL_BACKGROUND (w, findex) : - FACE_BACKGROUND (Vdefault_face, locale)); - mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, Qnil, color, Qnil); - ExtTextOut (FRAME_MSWINDOWS_DC (f), 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL); + mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, Qnil, fcolor, Qnil); + ExtTextOut (FRAME_MSWINDOWS_DC (f), 0, 0, ETO_OPAQUE, + &rect, NULL, 0, NULL); } #ifdef HAVE_SCROLLBARS if (WINDOWP (locale)) - mswindows_redisplay_deadbox_maybe (w, &rect); + mswindows_redisplay_deadbox_maybe (XWINDOW (locale), &rect); #endif } @@ -1493,27 +1443,27 @@ mswindows_clear_to_window_end (struct window *w, int ypos1, int ypos2) XSETWINDOW (window, w); if (window_is_leftmost (w)) - mswindows_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), + redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), ypos1, FRAME_BORDER_WIDTH (f), height); if (bounds.left_in - bounds.left_out > 0) - mswindows_clear_region (window, + redisplay_clear_region (window, get_builtin_face_cache_index (w, Vleft_margin_face), bounds.left_out, ypos1, bounds.left_in - bounds.left_out, height); if (bounds.right_in - bounds.left_in > 0) - mswindows_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1, + redisplay_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1, bounds.right_in - bounds.left_in, height); if (bounds.right_out - bounds.right_in > 0) - mswindows_clear_region (window, + redisplay_clear_region (window, get_builtin_face_cache_index (w, Vright_margin_face), bounds.right_in, ypos1, bounds.right_out - bounds.right_in, height); if (window_is_rightmost (w)) - mswindows_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), + redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), ypos1, FRAME_BORDER_WIDTH (f), height); } diff --git a/src/redisplay-output.c b/src/redisplay-output.c index 612334e..49e6dbb 100644 --- a/src/redisplay-output.c +++ b/src/redisplay-output.c @@ -432,13 +432,12 @@ static void clear_left_border (struct window *w, int y, int height) { struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); Lisp_Object window; XSETWINDOW (window, w); - DEVMETH (d, clear_region, (window, DEFAULT_INDEX, - FRAME_LEFT_BORDER_START (f), y, - FRAME_BORDER_WIDTH (f), height)); + redisplay_clear_region (window, DEFAULT_INDEX, + FRAME_LEFT_BORDER_START (f), y, + FRAME_BORDER_WIDTH (f), height); } /***************************************************************************** @@ -450,13 +449,12 @@ static void clear_right_border (struct window *w, int y, int height) { struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); Lisp_Object window; XSETWINDOW (window, w); - DEVMETH (d, clear_region, (window, DEFAULT_INDEX, - FRAME_RIGHT_BORDER_START (f), - y, FRAME_BORDER_WIDTH (f), height)); + redisplay_clear_region (window, DEFAULT_INDEX, + FRAME_RIGHT_BORDER_START (f), + y, FRAME_BORDER_WIDTH (f), height); } /***************************************************************************** @@ -617,10 +615,8 @@ output_display_line (struct window *w, display_line_dynarr *cdla, XSETWINDOW (window, w); /* Clear the empty area. */ - DEVMETH (d, clear_region, - (window, get_builtin_face_cache_index (w, - face), - x, y, width, height)); + redisplay_clear_region (window, get_builtin_face_cache_index (w, face), + x, y, width, height); /* Mark that we should clear the border. This is necessary because italic fonts may leave @@ -985,6 +981,208 @@ redisplay_redraw_cursor (struct frame *f, int run_end_begin_meths) redraw_cursor_in_window (XWINDOW (window), run_end_begin_meths); } +/**************************************************************************** + redisplay_unmap_subwindows + + Remove subwindows from the area in the box defined by the given + parameters. + ****************************************************************************/ +static void redisplay_unmap_subwindows (struct frame* f, int x, int y, int width, int height) +{ + int elt; + + for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) + { + struct subwindow_cachel *cachel = + Dynarr_atp (f->subwindow_cachels, elt); + + if (cachel->being_displayed + && + cachel->x + cachel->width > x && cachel->x < x + width + && + cachel->y + cachel->height > y && cachel->y < y + height) + { + unmap_subwindow (cachel->subwindow); + } + } +} + +/**************************************************************************** + redisplay_output_subwindow + + + output a subwindow. This code borrows heavily from the pixmap stuff, + although is much simpler not needing to account for partial + pixmaps, backgrounds etc. + ****************************************************************************/ +void +redisplay_output_subwindow (struct window *w, struct display_line *dl, + Lisp_Object image_instance, int xpos, int xoffset, + int start_pixpos, int width, face_index findex, + int cursor_start, int cursor_width, int cursor_height) +{ + struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); + Lisp_Object window; + + int lheight = dl->ascent + dl->descent - dl->clip; + int pheight = ((int) IMAGE_INSTANCE_SUBWINDOW_HEIGHT (p) > lheight ? lheight : + IMAGE_INSTANCE_SUBWINDOW_HEIGHT (p)); + + XSETWINDOW (window, w); + + /* Clear the area the subwindow is going into. The subwindow itself + will always take care of the full width. We don't want to clear + where it is going to go in order to avoid flicker. So, all we + have to take care of is any area above or below the subwindow. Of + course this is rubbish if the subwindow has transparent areas + (for instance with frames). */ + /* #### We take a shortcut for now. We know that since we have + subwindow_offset hardwired to 0 that the subwindow is against the top + edge so all we have to worry about is below it. */ + if ((int) (dl->ypos - dl->ascent + pheight) < + (int) (dl->ypos + dl->descent - dl->clip)) + { + int clear_x, clear_width; + + int clear_y = dl->ypos - dl->ascent + pheight; + int clear_height = lheight - pheight; + + if (start_pixpos >= 0 && start_pixpos > xpos) + { + clear_x = start_pixpos; + clear_width = xpos + width - start_pixpos; + } + else + { + clear_x = xpos; + clear_width = width; + } + + redisplay_clear_region (window, findex, clear_x, clear_y, + clear_width, clear_height); + } +#if 0 + redisplay_clear_region (window, findex, xpos - xoffset, dl->ypos - dl->ascent, + width, lheight); +#endif + /* if we can't view the whole window we can't view any of it */ + if (IMAGE_INSTANCE_SUBWINDOW_HEIGHT (p) > lheight + || + IMAGE_INSTANCE_SUBWINDOW_WIDTH (p) > width) + { + redisplay_clear_region (window, findex, xpos - xoffset, dl->ypos - dl->ascent, + width, lheight); + unmap_subwindow (image_instance); + } + else + map_subwindow (image_instance, xpos - xoffset, dl->ypos - dl->ascent); +} + +/**************************************************************************** + redisplay_clear_region + + Clear the area in the box defined by the given parameters using the + given face. This has been generalised so that subwindows can be + coped with effectively. + ****************************************************************************/ +void +redisplay_clear_region (Lisp_Object locale, face_index findex, int x, int y, + int width, int height) +{ + struct window *w = NULL; + struct frame *f = NULL; + struct device *d; + Lisp_Object background_pixmap = Qunbound; + Lisp_Object fcolor = Qnil, bcolor = Qnil; + + if (!width || !height) + return; + + if (WINDOWP (locale)) + { + w = XWINDOW (locale); + f = XFRAME (w->frame); + } + else if (FRAMEP (locale)) + { + w = NULL; + f = XFRAME (locale); + } + else + abort (); + + d = XDEVICE (f->device); + + /* if we have subwindows in the region we have to unmap them */ + if (Dynarr_length (FRAME_SUBWINDOW_CACHE (f))) + { + redisplay_unmap_subwindows (f, x, y, width, height); + } + + /* #### This isn't quite right for when this function is called + from the toolbar code. */ + + /* Don't use a backing pixmap in the border area */ + if (x >= FRAME_LEFT_BORDER_END (f) + && x < FRAME_RIGHT_BORDER_START (f) + && y >= FRAME_TOP_BORDER_END (f) + && y < FRAME_BOTTOM_BORDER_START (f)) + { + Lisp_Object temp; + + if (w) + { + temp = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, findex); + + if (IMAGE_INSTANCEP (temp) + && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) + { + /* #### maybe we could implement such that a string + can be a background pixmap? */ + background_pixmap = temp; + } + } + else + { + temp = FACE_BACKGROUND_PIXMAP (Vdefault_face, locale); + + if (IMAGE_INSTANCEP (temp) + && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) + { + background_pixmap = temp; + } + } + } + + if (!UNBOUNDP (background_pixmap) && + XIMAGE_INSTANCE_PIXMAP_DEPTH (background_pixmap) == 0) + { + if (w) + { + fcolor = WINDOW_FACE_CACHEL_FOREGROUND (w, findex); + bcolor = WINDOW_FACE_CACHEL_BACKGROUND (w, findex); + } + else + { + fcolor = FACE_FOREGROUND (Vdefault_face, locale); + bcolor = FACE_BACKGROUND (Vdefault_face, locale); + } + } + else + { + fcolor = (w ? + WINDOW_FACE_CACHEL_BACKGROUND (w, findex) : + FACE_BACKGROUND (Vdefault_face, locale)); + + } + + if (UNBOUNDP (background_pixmap)) + background_pixmap = Qnil; + + DEVMETH (d, clear_region, + (locale, d, f, findex, x, y, width, height, fcolor, bcolor, background_pixmap)); +} + /***************************************************************************** redisplay_clear_top_of_window @@ -999,7 +1197,6 @@ redisplay_clear_top_of_window (struct window *w) if (!NILP (Fwindow_highest_p (window))) { struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); int x, y, width, height; x = w->pixel_left; @@ -1016,7 +1213,7 @@ redisplay_clear_top_of_window (struct window *w) y = FRAME_TOP_BORDER_START (f) - 1; height = FRAME_BORDER_HEIGHT (f) + 1; - DEVMETH (d, clear_region, (window, DEFAULT_INDEX, x, y, width, height)); + redisplay_clear_region (window, DEFAULT_INDEX, x, y, width, height); } } diff --git a/src/redisplay-tty.c b/src/redisplay-tty.c index 4576b45..08899fa 100644 --- a/src/redisplay-tty.c +++ b/src/redisplay-tty.c @@ -391,6 +391,7 @@ tty_output_display_block (struct window *w, struct display_line *dl, int block, case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: case IMAGE_SUBWINDOW: + case IMAGE_WIDGET: /* just do nothing here */ break; @@ -461,16 +462,14 @@ tty_output_vertical_divider (struct window *w, int clear) Clear the area in the box defined by the given parameters. ****************************************************************************/ static void -tty_clear_region (Lisp_Object window, face_index findex, int x, int y, - int width, int height) +tty_clear_region (Lisp_Object window, struct device* d, struct frame * f, + face_index findex, int x, int y, + int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, + Lisp_Object background_pixmap) { - struct window *w = XWINDOW (window); - struct frame *f = XFRAME (w->frame); struct console *c = XCONSOLE (FRAME_CONSOLE (f)); int line; - - if (!width || !height) - return; + struct window* w = XWINDOW (window); tty_turn_on_face (w, findex); for (line = y; line < y + height; line++) @@ -534,7 +533,7 @@ tty_clear_to_window_end (struct window *w, int ypos1, int ypos2) Lisp_Object window; XSETWINDOW (window, w); - tty_clear_region (window, DEFAULT_INDEX, x, ypos1, width, ypos2 - ypos1); + redisplay_clear_region (window, DEFAULT_INDEX, x, ypos1, width, ypos2 - ypos1); } } @@ -959,7 +958,7 @@ tty_redisplay_shutdown (struct console *c) struct frame *f = XFRAME (frm); /* Clear the bottom line of the frame. */ - tty_clear_region (FRAME_SELECTED_WINDOW (f), DEFAULT_INDEX, 0, + redisplay_clear_region (FRAME_SELECTED_WINDOW (f), DEFAULT_INDEX, 0, f->height, f->width, 1); /* And then stick the cursor there. */ diff --git a/src/redisplay-x.c b/src/redisplay-x.c index 39b4c1d..492231c 100644 --- a/src/redisplay-x.c +++ b/src/redisplay-x.c @@ -74,8 +74,6 @@ static void x_redraw_exposed_window (struct window *w, int x, int y, int width, int height); static void x_redraw_exposed_windows (Lisp_Object window, int x, int y, int width, int height); -static void x_clear_region (Lisp_Object window, face_index findex, int x, - int y, int width, int height); static void x_output_eol_cursor (struct window *w, struct display_line *dl, int xpos, face_index findex); static void x_clear_frame (struct frame *f); @@ -416,7 +414,7 @@ x_output_display_block (struct window *w, struct display_line *dl, int block, /* Clear in case a cursor was formerly here. */ int height = dl->ascent + dl->descent - dl->clip; - x_clear_region (window, findex, xpos, dl->ypos - dl->ascent, + redisplay_clear_region (window, findex, xpos, dl->ypos - dl->ascent, rb->width, height); elt++; } @@ -490,9 +488,12 @@ x_output_display_block (struct window *w, struct display_line *dl, int block, case IMAGE_POINTER: abort (); + case IMAGE_WIDGET: case IMAGE_SUBWINDOW: - /* #### implement me */ - break; + redisplay_output_subwindow (w, dl, instance, xpos, + rb->object.dglyph.xoffset, start_pixpos, + rb->width, findex, cursor_start, + cursor_width, cursor_height); case IMAGE_NOTHING: /* nothing is as nothing does */ @@ -902,21 +903,21 @@ x_output_string (struct window *w, struct display_line *dl, if (ypos1_line < ypos1_string) { - x_clear_region (window, findex, clear_start, ypos1_line, + redisplay_clear_region (window, findex, clear_start, ypos1_line, clear_end - clear_start, ypos1_string - ypos1_line); } if (ypos2_line > ypos2_string) { - x_clear_region (window, findex, clear_start, ypos2_string, + redisplay_clear_region (window, findex, clear_start, ypos2_string, clear_end - clear_start, ypos2_line - ypos2_string); } } else { - x_clear_region (window, findex, clear_start, + redisplay_clear_region (window, findex, clear_start, dl->ypos - dl->ascent, clear_end - clear_start, height); } @@ -1334,7 +1335,7 @@ x_output_pixmap (struct window *w, struct display_line *dl, clear_width = width; } - x_clear_region (window, findex, clear_x, clear_y, + redisplay_clear_region (window, findex, clear_x, clear_y, clear_width, clear_height); } @@ -1836,27 +1837,27 @@ x_clear_to_window_end (struct window *w, int ypos1, int ypos2) XSETWINDOW (window, w); if (window_is_leftmost (w)) - x_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), + redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), ypos1, FRAME_BORDER_WIDTH (f), height); if (bounds.left_in - bounds.left_out > 0) - x_clear_region (window, + redisplay_clear_region (window, get_builtin_face_cache_index (w, Vleft_margin_face), bounds.left_out, ypos1, bounds.left_in - bounds.left_out, height); if (bounds.right_in - bounds.left_in > 0) - x_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1, + redisplay_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1, bounds.right_in - bounds.left_in, height); if (bounds.right_out - bounds.right_in > 0) - x_clear_region (window, + redisplay_clear_region (window, get_builtin_face_cache_index (w, Vright_margin_face), bounds.right_in, ypos1, bounds.right_out - bounds.right_in, height); if (window_is_rightmost (w)) - x_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), + redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), ypos1, FRAME_BORDER_WIDTH (f), height); } } @@ -1996,110 +1997,27 @@ x_redraw_exposed_area (struct frame *f, int x, int y, int width, int height) given face. ****************************************************************************/ static void -x_clear_region (Lisp_Object locale, face_index findex, int x, int y, - int width, int height) +x_clear_region (Lisp_Object locale, struct device* d, struct frame* f, face_index findex, + int x, int y, + int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, + Lisp_Object background_pixmap) { - struct window *w = NULL; - struct frame *f = NULL; - struct device *d; - Lisp_Object background_pixmap; - Display *dpy; Window x_win; + GC gc = NULL; - if (WINDOWP (locale)) - { - w = XWINDOW (locale); - f = XFRAME (w->frame); - } - else if (FRAMEP (locale)) - { - w = NULL; - f = XFRAME (locale); - } - else - abort (); - - d = XDEVICE (f->device); dpy = DEVICE_X_DISPLAY (d); x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - /* #### This function is going to have to be made cursor aware. */ - if (width && height) + if (!UNBOUNDP (background_pixmap)) { - GC gc = NULL; - - /* #### This isn't quite right for when this function is called - from the toolbar code. */ - background_pixmap = Qunbound; - - /* Don't use a backing pixmap in the border area */ - if (x >= FRAME_LEFT_BORDER_END (f) - && x < FRAME_RIGHT_BORDER_START (f) - && y >= FRAME_TOP_BORDER_END (f) - && y < FRAME_BOTTOM_BORDER_START (f)) - { - Lisp_Object temp; - - if (w) - { - temp = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, findex); - - if (IMAGE_INSTANCEP (temp) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) - { - /* #### maybe we could implement such that a string - can be a background pixmap? */ - background_pixmap = temp; - } - } - else - { - temp = FACE_BACKGROUND_PIXMAP (Vdefault_face, locale); - - if (IMAGE_INSTANCEP (temp) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) - { - background_pixmap = temp; - } - } - - if (!UNBOUNDP (background_pixmap) && - XIMAGE_INSTANCE_PIXMAP_DEPTH (background_pixmap) == 0) - { - Lisp_Object fcolor, bcolor; - - if (w) - { - fcolor = WINDOW_FACE_CACHEL_FOREGROUND (w, findex); - bcolor = WINDOW_FACE_CACHEL_BACKGROUND (w, findex); - } - else - { - fcolor = FACE_FOREGROUND (Vdefault_face, locale); - bcolor = FACE_BACKGROUND (Vdefault_face, locale); - } - - gc = x_get_gc (d, Qnil, fcolor, bcolor, background_pixmap, Qnil); - } - else - { - Lisp_Object color = (w ? - WINDOW_FACE_CACHEL_BACKGROUND (w, findex) : - FACE_BACKGROUND (Vdefault_face, locale)); - - if (UNBOUNDP (background_pixmap)) - background_pixmap = Qnil; - - gc = x_get_gc (d, Qnil, color, Qnil, background_pixmap, Qnil); - } - } - - if (gc) - XFillRectangle (dpy, x_win, gc, x, y, width, height); - else - XClearArea (dpy, x_win, x, y, width, height, False); + gc = x_get_gc (d, Qnil, fcolor, bcolor, background_pixmap, Qnil); } + + if (gc) + XFillRectangle (dpy, x_win, gc, x, y, width, height); + else + XClearArea (dpy, x_win, x, y, width, height, False); } /***************************************************************************** @@ -2134,7 +2052,7 @@ x_output_eol_cursor (struct window *w, struct display_line *dl, int xpos, int defheight, defascent; XSETWINDOW (window, w); - x_clear_region (window, findex, x, y, width, height); + redisplay_clear_region (window, findex, x, y, width, height); if (NILP (w->text_cursor_visible_p)) return; diff --git a/src/redisplay.c b/src/redisplay.c index af19d9b..73a5a15 100644 --- a/src/redisplay.c +++ b/src/redisplay.c @@ -256,7 +256,8 @@ static prop_block_dynarr *add_glyph_rune (pos_data *data, struct glyph_cachel *cachel); static Bytind create_text_block (struct window *w, struct display_line *dl, Bytind bi_start_pos, int start_col, - prop_block_dynarr **prop, int type); + prop_block_dynarr **prop, + int type); static int create_overlay_glyph_block (struct window *w, struct display_line *dl); static void create_left_glyph_block (struct window *w, @@ -365,6 +366,11 @@ int frame_changed; int glyphs_changed; int glyphs_changed_set; +/* non-zero if any displayed subwindow is in need of updating + somewhere. */ +int subwindows_changed; +int subwindows_changed_set; + /* This variable is 1 if the icon has to be updated. It is set to 1 when `frame-icon-glyph' changes. */ int icon_changed; @@ -681,7 +687,8 @@ calculate_display_line_boundaries (struct window *w, int modeline) static Bufpos generate_display_line (struct window *w, struct display_line *dl, int bounds, Bufpos start_pos, int start_col, - prop_block_dynarr **prop, int type) + prop_block_dynarr **prop, + int type) { Bufpos ret_bufpos; int overlay_width; @@ -1233,66 +1240,12 @@ add_control_char_runes (pos_data *data, struct buffer *b) } } -/* Given a display table entry, call the appropriate functions to - display each element of the entry. */ - static prop_block_dynarr * -add_disp_table_entry_runes (pos_data *data, Lisp_Object entry) +add_disp_table_entry_runes_1 (pos_data *data, Lisp_Object entry) { prop_block_dynarr *prop = NULL; - if (VECTORP (entry)) - { - struct Lisp_Vector *de = XVECTOR (entry); - long len = vector_length (de); - int elt; - - for (elt = 0; elt < len; elt++) - { - if (NILP (de->contents[elt])) - continue; - else if (STRINGP (de->contents[elt])) - { - prop = - add_bufbyte_string_runes - (data, - XSTRING_DATA (de->contents[elt]), - XSTRING_LENGTH (de->contents[elt]), - 0); - } - else if (GLYPHP (de->contents[elt])) - { - if (data->start_col) - data->start_col--; - - if (!data->start_col && data->bi_start_col_enabled) - { - prop = add_hscroll_rune (data); - } - else - { - struct glyph_block gb; - - gb.glyph = de->contents[elt]; - gb.extent = Qnil; - prop = add_glyph_rune (data, &gb, BEGIN_GLYPHS, 0, 0); - } - } - else if (CHAR_OR_CHAR_INTP (de->contents[elt])) - { - data->ch = XCHAR_OR_CHAR_INT (de->contents[elt]); - prop = add_emchar_rune (data); - } - /* Else blow it off because someone added a bad entry and we - don't have any safe way of signaling an error. */ - - /* #### Still need to add any remaining elements to the - propagation information. */ - if (prop) - return prop; - } - } - else if (STRINGP (entry)) + if (STRINGP (entry)) { prop = add_bufbyte_string_runes (data, XSTRING_DATA (entry), @@ -1322,10 +1275,79 @@ add_disp_table_entry_runes (pos_data *data, Lisp_Object entry) data->ch = XCHAR_OR_CHAR_INT (entry); prop = add_emchar_rune (data); } + else if (CONSP (entry)) + { + if (EQ (XCAR (entry), Qformat) + && CONSP (XCDR (entry)) + && STRINGP (XCAR (XCDR (entry)))) + { + Lisp_Object format = XCAR (XCDR (entry)); + Bytind len = XSTRING_LENGTH (format); + Bufbyte *src = XSTRING_DATA (format), *end = src + len; + Bufbyte *result = alloca_array (Bufbyte, len); + Bufbyte *dst = result; + + while (src < end) + { + Emchar c = charptr_emchar (src); + INC_CHARPTR (src); + if (c != '%' || src == end) + dst += set_charptr_emchar (dst, c); + else + { + c = charptr_emchar (src); + INC_CHARPTR (src); + switch (c) + { + /*case 'x': + dst += long_to_string_base ((char *)dst, data->ch, 16); + break;*/ + case '%': + dst += set_charptr_emchar (dst, '%'); + break; + } + } + } + prop = add_bufbyte_string_runes (data, result, dst - result, 0); + } + } /* Else blow it off because someone added a bad entry and we don't - have any safe way of signaling an error. Hey, this comment - sounds familiar. */ + have any safe way of signaling an error. */ + return prop; +} + +/* Given a display table entry, call the appropriate functions to + display each element of the entry. */ + +static prop_block_dynarr * +add_disp_table_entry_runes (pos_data *data, Lisp_Object entry) +{ + prop_block_dynarr *prop = NULL; + if (VECTORP (entry)) + { + struct Lisp_Vector *de = XVECTOR (entry); + EMACS_INT len = vector_length (de); + int elt; + + for (elt = 0; elt < len; elt++) + { + if (NILP (vector_data (de)[elt])) + continue; + else + prop = add_disp_table_entry_runes_1 (data, vector_data (de)[elt]); + /* Else blow it off because someone added a bad entry and we + don't have any safe way of signaling an error. Hey, this + comment sounds familiar. */ + + /* #### Still need to add any remaining elements to the + propagation information. */ + if (prop) + return prop; + } + } + else + prop = add_disp_table_entry_runes_1 (data, entry); return prop; } @@ -1744,14 +1766,14 @@ add_glyph_runes (pos_data *data, int pos_type) static Bytind create_text_block (struct window *w, struct display_line *dl, Bytind bi_start_pos, int start_col, - prop_block_dynarr **prop, int type) + prop_block_dynarr **prop, + int type) { struct frame *f = XFRAME (w->frame); struct buffer *b = XBUFFER (w->buffer); struct device *d = XDEVICE (f->device); pos_data data; - struct Lisp_Vector *dt = 0; /* Don't display anything in the minibuffer if this window is not on a selected frame. We consider all other windows to be active @@ -1784,46 +1806,41 @@ create_text_block (struct window *w, struct display_line *dl, into a more general conversion mechanism. Ideally you could specify a Lisp function that converts characters, but this violates the Second Golden Rule and besides would - make things way way way way slow. An idea I like is to - be able to specify multiple display tables instead of just - one. Each display table can specify conversions for some - characters and leave others unchanged. The way the - character gets displayed is determined by the first display - table with a binding for that character. This way, you - could call a function `enable-hex-display' that adds a - pre-defined hex display-table (or maybe computes one if - you give weird parameters to the function) and adds it - to the list of display tables for the current buffer. - - Unfortunately there are still problems dealing with Mule - characters. For example, maybe I want to specify that - all extended characters (i.e. >= 256) are displayed in hex. - It's not reasonable to create a mapping for all possible - such characters, because there are about 2^19 of them. - One way of dealing with this is to extend the concept - of what a display table is. Currently it's only allowed - to be a 256-entry vector. Instead, it should be something - like: - - a) A 256-entry vector, for backward compatibility - b) Some sort of hash table, mapping characters to values - c) A list that specifies a range of values and the - mapping to provide for those values. - - Also, extend the concept of "mapping" to include a - printf-like spec. Then, you could make all extended - characters show up as hex with a display table like - - ((256 . 524288) . "%x") + make things way way way way slow. + + So instead, we extend the display-table concept, which was + historically limited to 256-byte vectors, to one of the + following: + + a) A 256-entry vector, for backward compatibility; + b) char-table, mapping characters to values; + c) range-table, mapping ranges of characters to values; + d) a list of the above. + + The (d) option allows you to specify multiple display tables + instead of just one. Each display table can specify conversions + for some characters and leave others unchanged. The way the + character gets displayed is determined by the first display table + with a binding for that character. This way, you could call a + function `enable-hex-display' that adds a hex display-table to + the list of display tables for the current buffer. + + #### ...not yet implemented... Also, we extend the concept of + "mapping" to include a printf-like spec. Thus you can make all + extended characters show up as hex with a display table like + this: + + #s(range-table data ((256 524288) (format "%x"))) Since more than one display table is possible, you have - great flexibility in mapping ranges of characters. - */ + great flexibility in mapping ranges of characters. */ Emchar printable_min = (CHAR_OR_CHAR_INTP (b->ctl_arrow) ? XCHAR_OR_CHAR_INT (b->ctl_arrow) : ((EQ (b->ctl_arrow, Qt) || EQ (b->ctl_arrow, Qnil)) ? 255 : 160)); + Lisp_Object face_dt, window_dt; + /* The text display block for this display line. */ struct display_block *db = get_display_block_from_line (dl, TEXT); @@ -1962,10 +1979,10 @@ create_text_block (struct window *w, struct display_line *dl, /* Remember that the extent-fragment routines deal in Bytind's. */ extent_fragment_update (w, data.ef, data.bi_bufpos); + get_display_tables (w, data.findex, &face_dt, &window_dt); + if (data.bi_bufpos == data.ef->end) no_more_frags = 1; - - dt = get_display_table (w, data.findex); } initial = 0; @@ -2077,16 +2094,17 @@ create_text_block (struct window *w, struct display_line *dl, else { + Lisp_Object entry = Qnil; /* Get the character at the current buffer position. */ data.ch = BI_BUF_FETCH_CHAR (b, data.bi_bufpos); + if (!NILP (face_dt) || !NILP (window_dt)) + entry = display_table_entry (data.ch, face_dt, window_dt); /* If there is a display table entry for it, hand it off to add_disp_table_entry_runes and let it worry about it. */ - if (dt && !NILP (DISP_CHAR_ENTRY (dt, data.ch))) + if (!NILP (entry) && !EQ (entry, make_char (data.ch))) { - *prop = - add_disp_table_entry_runes (&data, - DISP_CHAR_ENTRY (dt, data.ch)); + *prop = add_disp_table_entry_runes (&data, entry); if (*prop) goto done; @@ -4310,7 +4328,7 @@ regenerate_window (struct window *w, Bufpos start_pos, Bufpos point, int type) } if (prop) - Dynarr_free (prop); + Dynarr_free (prop); /* #### More not quite right, but close enough. */ /* #### Ben sez: apparently window_end_pos[] is measured @@ -4625,11 +4643,9 @@ regenerate_window_incrementally (struct window *w, Bufpos startp, /* If the changes are below the visible area then if point hasn't moved return success otherwise fail in order to be safe. */ if (line > dla_end) - { - return regenerate_window_extents_only_changed (w, startp, pointm, - extent_beg_unchanged, - extent_end_unchanged); - } + return regenerate_window_extents_only_changed (w, startp, pointm, + extent_beg_unchanged, + extent_end_unchanged); else /* At this point we know what line the changes first affect. We now redraw that line. If the changes are contained within it @@ -4753,12 +4769,9 @@ regenerate_window_incrementally (struct window *w, Bufpos startp, && extent_end_unchanged != -1 && ((extent_beg_unchanged < ddl->bufpos) || (extent_end_unchanged > ddl->end_bufpos))) - { - return - regenerate_window_extents_only_changed (w, startp, pointm, - extent_beg_unchanged, - extent_end_unchanged); - } + return regenerate_window_extents_only_changed (w, startp, pointm, + extent_beg_unchanged, + extent_end_unchanged); else return 1; } @@ -5081,6 +5094,7 @@ redisplay_window (Lisp_Object window, int skip_selected) && !f->extents_changed && !f->faces_changed && !f->glyphs_changed + && !f->subwindows_changed && !f->point_changed && !f->windows_structure_changed) { @@ -5101,6 +5115,7 @@ redisplay_window (Lisp_Object window, int skip_selected) && !f->extents_changed && !f->faces_changed && !f->glyphs_changed + && !f->subwindows_changed && !f->windows_structure_changed) { if (point_visible (w, pointm, CURRENT_DISP) @@ -5158,6 +5173,7 @@ redisplay_window (Lisp_Object window, int skip_selected) && !f->clip_changed && !f->faces_changed && !f->glyphs_changed + && !f->subwindows_changed && !f->windows_structure_changed && !f->frame_changed && !truncation_changed @@ -5374,7 +5390,11 @@ redisplay_frame (struct frame *f, int preemption_check) being handled. */ update_frame_menubars (f); #endif /* HAVE_MENUBARS */ - + /* widgets are similar to menus in that they can call lisp to + determine activation etc. Therefore update them before we get + into redisplay. This is primarily for connected widgets such as + radio buttons. */ + update_frame_subwindows (f); #ifdef HAVE_TOOLBARS /* Update the toolbars. */ update_frame_toolbars (f); @@ -5412,7 +5432,20 @@ redisplay_frame (struct frame *f, int preemption_check) /* Erase the frame before outputting its contents. */ if (f->clear) - DEVMETH (d, clear_frame, (f)); + { + DEVMETH (d, clear_frame, (f)); + } + + /* invalidate the subwindow cache. we are going to reuse the glyphs + flag here to cause subwindows to get instantiated. This is + because subwindows changed is less strict - dealing with things + like the clicked state of button. */ + if (!Dynarr_length (f->subwindow_cachels) + || f->glyphs_changed + || f->frame_changed) + reset_subwindow_cachels (f); + else + mark_subwindow_cachels_as_not_updated (f); /* Do the selected window first. */ redisplay_window (FRAME_SELECTED_WINDOW (f), 0); @@ -5434,6 +5467,7 @@ redisplay_frame (struct frame *f, int preemption_check) f->faces_changed = 0; f->frame_changed = 0; f->glyphs_changed = 0; + f->subwindows_changed = 0; f->icon_changed = 0; f->menubar_changed = 0; f->modeline_changed = 0; @@ -5497,7 +5531,7 @@ redisplay_device (struct device *d) f->faces_changed || f->frame_changed || f->menubar_changed || f->modeline_changed || f->point_changed || f->size_changed || f->toolbar_changed || f->windows_changed || f->size_slipped || - f->windows_structure_changed || f->glyphs_changed) + f->windows_structure_changed || f->glyphs_changed || f->subwindows_changed) { preempted = redisplay_frame (f, 0); } @@ -5532,7 +5566,7 @@ redisplay_device (struct device *d) f->modeline_changed || f->point_changed || f->size_changed || f->toolbar_changed || f->windows_changed || f->windows_structure_changed || - f->glyphs_changed) + f->glyphs_changed || f->subwindows_changed) { preempted = redisplay_frame (f, 0); } @@ -5553,6 +5587,7 @@ redisplay_device (struct device *d) d->faces_changed = 0; d->frame_changed = 0; d->glyphs_changed = 0; + d->subwindows_changed = 0; d->icon_changed = 0; d->menubar_changed = 0; d->modeline_changed = 0; @@ -5598,7 +5633,7 @@ redisplay_without_hooks (void) !faces_changed && !frame_changed && !icon_changed && !menubar_changed && !modeline_changed && !point_changed && !size_changed && !toolbar_changed && !windows_changed && - !glyphs_changed && + !glyphs_changed && !subwindows_changed && !windows_structure_changed && !disable_preemption && preemption_count < max_preempts) goto done; @@ -5613,7 +5648,7 @@ redisplay_without_hooks (void) d->menubar_changed || d->modeline_changed || d->point_changed || d->size_changed || d->toolbar_changed || d->windows_changed || d->windows_structure_changed || - d->glyphs_changed) + d->glyphs_changed || d->subwindows_changed) { preempted = redisplay_device (d); @@ -5637,6 +5672,7 @@ redisplay_without_hooks (void) extents_changed = 0; frame_changed = 0; glyphs_changed = 0; + subwindows_changed = 0; icon_changed = 0; menubar_changed = 0; modeline_changed = 0; diff --git a/src/redisplay.h b/src/redisplay.h index 9059d4c..8f8db18 100644 --- a/src/redisplay.h +++ b/src/redisplay.h @@ -350,6 +350,11 @@ extern int frame_changed; extern int glyphs_changed; extern int glyphs_changed_set; +/* True if any displayed subwindow is in need of updating + somewhere. */ +extern int subwindows_changed; +extern int subwindows_changed_set; + /* True if an icon is in need of updating somewhere. */ extern int icon_changed; extern int icon_changed_set; @@ -417,6 +422,7 @@ extern int windows_structure_changed; #define MARK_POINT_CHANGED MARK_TYPE_CHANGED (point) #define MARK_TOOLBAR_CHANGED MARK_TYPE_CHANGED (toolbar) #define MARK_GLYPHS_CHANGED MARK_TYPE_CHANGED (glyphs) +#define MARK_SUBWINDOWS_CHANGED MARK_TYPE_CHANGED (subwindows) /* Anytime a console, device or frame is added or deleted we need to reset these flags. */ @@ -431,6 +437,7 @@ extern int windows_structure_changed; point_changed_set = 0; \ toolbar_changed_set = 0; \ glyphs_changed_set = 0; \ + subwindows_changed_set = 0; \ } while (0) @@ -547,6 +554,13 @@ int compute_line_start_cache_dynarr_usage (line_start_cache_dynarr *dyn, int get_next_display_block (layout_bounds bounds, display_block_dynarr *dba, int start_pos, int *next_start); +void redisplay_output_subwindow (struct window *w, struct display_line *dl, + Lisp_Object image_instance, int xpos, + int xoffset, int start_pixpos, int width, + face_index findex, int cursor_start, + int cursor_width, int cursor_height); +void redisplay_clear_region (Lisp_Object window, face_index findex, int x, + int y, int width, int height); void redisplay_clear_bottom_of_window (struct window *w, display_line_dynarr *ddla, int min_start, int max_end); diff --git a/src/sound.c b/src/sound.c index fa52599..764e147 100644 --- a/src/sound.c +++ b/src/sound.c @@ -68,8 +68,9 @@ Lisp_Object Qnas; DEFUN ("play-sound-file", Fplay_sound_file, 1, 3, "fSound file name: ", /* Play the named sound file on DEVICE's speaker at the specified volume \(0-100, default specified by the `bell-volume' variable). -The sound file must be in the Sun/NeXT U-LAW format except under Linux -where WAV files are also supported. +On Unix machines the sound file must be in the Sun/NeXT U-LAW format +except under Linux where WAV files are also supported. On Microsoft +Windows the sound file must be in WAV format. DEVICE defaults to the selected device. */ (file, volume, device)) diff --git a/src/specifier.c b/src/specifier.c index a0e5387..65fcdae 100644 --- a/src/specifier.c +++ b/src/specifier.c @@ -37,7 +37,8 @@ Boston, MA 02111-1307, USA. */ #include "opaque.h" #include "specifier.h" #include "window.h" -#include "glyphs.h" /* for DISP_TABLE_SIZE definition */ +#include "chartab.h" +#include "rangetab.h" Lisp_Object Qspecifierp; Lisp_Object Qprepend, Qappend, Qremove_tag_set_prepend, Qremove_tag_set_append; @@ -2998,14 +2999,38 @@ Return non-nil if OBJECT is a boolean specifier. DEFINE_SPECIFIER_TYPE (display_table); +#define VALID_SINGLE_DISPTABLE_INSTANTIATOR_P(instantiator) \ + (VECTORP (instantiator) \ + || (CHAR_TABLEP (instantiator) \ + && (XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_CHAR \ + || XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_GENERIC)) \ + || RANGE_TABLEP (instantiator)) + static void display_table_validate (Lisp_Object instantiator) { - if (!NILP(instantiator) && - (!VECTORP (instantiator) || - XVECTOR_LENGTH (instantiator) != DISP_TABLE_SIZE)) - dead_wrong_type_argument (display_table_specifier_methods->predicate_symbol, - instantiator); + if (NILP (instantiator)) + /* OK */ + ; + else if (CONSP (instantiator)) + { + Lisp_Object tail; + EXTERNAL_LIST_LOOP (tail, instantiator) + { + Lisp_Object car = XCAR (tail); + if (!VALID_SINGLE_DISPTABLE_INSTANTIATOR_P (car)) + goto lose; + } + } + else + { + if (!VALID_SINGLE_DISPTABLE_INSTANTIATOR_P (instantiator)) + { + lose: + dead_wrong_type_argument (display_table_specifier_methods->predicate_symbol, + instantiator); + } + } } DEFUN ("display-table-specifier-p", Fdisplay_table_specifier_p, 1, 1, 0, /* diff --git a/src/strftime.c b/src/strftime.c index 9145c74..cb0c111 100644 --- a/src/strftime.c +++ b/src/strftime.c @@ -234,7 +234,7 @@ mon_week (CONST struct tm *tm) #if !defined(HAVE_TM_ZONE) && !defined(HAVE_TZNAME) char * -zone_name (struct tm *tp) +zone_name (CONST struct tm *tp) { char *timezone (); struct timeval tv; diff --git a/src/symsinit.h b/src/symsinit.h index 4840c98..a210bd8 100644 --- a/src/symsinit.h +++ b/src/symsinit.h @@ -93,6 +93,7 @@ void syms_of_free_hook (void); void syms_of_general (void); void syms_of_glyphs_x (void); void syms_of_glyphs_eimage (void); +void syms_of_glyphs_widget (void); void syms_of_glyphs_mswindows (void); void syms_of_glyphs (void); void syms_of_gui_x (void); @@ -192,6 +193,7 @@ void structure_type_create_hash_table (void); void image_instantiator_format_create (void); void image_instantiator_format_create_glyphs_eimage (void); +void image_instantiator_format_create_glyphs_widget (void); void image_instantiator_format_create_glyphs_x (void); void image_instantiator_format_create_glyphs_mswindows (void); @@ -260,6 +262,7 @@ void vars_of_frame_x (void); void vars_of_frame (void); void vars_of_glyphs_x (void); void vars_of_glyphs_eimage (void); +void vars_of_glyphs_widget (void); void vars_of_glyphs_mswindows (void); void vars_of_glyphs (void); void vars_of_gui_x (void); diff --git a/src/toolbar-x.c b/src/toolbar-x.c index 735d63c..9961950 100644 --- a/src/toolbar-x.c +++ b/src/toolbar-x.c @@ -504,9 +504,9 @@ x_output_toolbar (struct frame *f, enum toolbar_pos pos) Lisp_Object frame; XSETFRAME (frame, f); - DEVMETH (d, clear_region, (frame, - DEFAULT_INDEX, FRAME_PIXWIDTH (f) - 1, y, 1, - bar_height)); + redisplay_clear_region (frame, + DEFAULT_INDEX, FRAME_PIXWIDTH (f) - 1, y, 1, + bar_height); } SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 1); @@ -542,7 +542,7 @@ x_clear_toolbar (struct frame *f, enum toolbar_pos pos, int thickness_change) SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 0); - DEVMETH (d, clear_region, (frame, DEFAULT_INDEX, x, y, width, height)); + redisplay_clear_region (frame, DEFAULT_INDEX, x, y, width, height); XFlush (DEVICE_X_DISPLAY (d)); } diff --git a/src/window.c b/src/window.c index db9f884..2f3a6b8 100644 --- a/src/window.c +++ b/src/window.c @@ -36,6 +36,8 @@ Boston, MA 02111-1307, USA. */ #include "glyphs.h" #include "redisplay.h" #include "window.h" +#include "elhash.h" +#include "commands.h" Lisp_Object Qwindowp, Qwindow_live_p, Qwindow_configurationp; Lisp_Object Qscroll_up, Qscroll_down, Qdisplay_buffer; @@ -161,6 +163,8 @@ mark_window (Lisp_Object obj, void (*markobj) (Lisp_Object)) MARK_DISP_VARIABLE (last_facechange); markobj (window->line_cache_last_updated); markobj (window->redisplay_end_trigger); + markobj (window->subwindow_instance_cache); + mark_face_cachels (window->face_cachels, markobj); mark_glyph_cachels (window->glyph_cachels, markobj); @@ -273,6 +277,9 @@ allocate_window (void) p->face_cachels = Dynarr_new (face_cachel); p->glyph_cachels = Dynarr_new (glyph_cachel); p->line_start_cache = Dynarr_new (line_start_cache); + p->subwindow_instance_cache = make_lisp_hash_table (10, + HASH_TABLE_KEY_WEAK, + HASH_TABLE_EQ); p->line_cache_last_updated = Qzero; INIT_DISP_VARIABLE (last_point_x, 0); INIT_DISP_VARIABLE (last_point_y, 0); diff --git a/src/window.h b/src/window.h index fd2e291..5bcfea6 100644 --- a/src/window.h +++ b/src/window.h @@ -145,8 +145,14 @@ struct window face_cachel_dynarr *face_cachels; /* glyph cache elements correct for this window and its current buffer */ glyph_cachel_dynarr *glyph_cachels; - - + /* we cannot have a per-device cache of widgets / subwindows because + each visible instance needs to be a separate instance. The lowest + level of granularity we can get easily is the window that the + subwindow is in. This will fail if we attach the same subwindow + twice to a buffer. However, we are quite unlikely to do this, + especially with buttons which will need individual callbacks. The + proper solution is probably not worth the effort. */ + Lisp_Object subwindow_instance_cache; /* List of starting positions for display lines. Only valid if buffer has not changed. */ line_start_cache_dynarr *line_start_cache; diff --git a/tests/automated/lisp-tests.el b/tests/automated/lisp-tests.el index f42f5d8..840afc1 100644 --- a/tests/automated/lisp-tests.el +++ b/tests/automated/lisp-tests.el @@ -725,3 +725,54 @@ (Assert (eq (type-of "42") 'string)) (Assert (eq (type-of 'foo) 'symbol)) (Assert (eq (type-of (selected-device)) 'device)) + +;;----------------------------------------------------- +;; Test mapping functions +;;----------------------------------------------------- +(Check-Error wrong-type-argument (mapcar #'identity (current-buffer))) +(Assert (equal (mapcar #'identity load-path) load-path)) +(Assert (equal (mapcar #'identity '(1 2 3)) '(1 2 3))) +(Assert (equal (mapcar #'identity "123") '(?1 ?2 ?3))) +(Assert (equal (mapcar #'identity [1 2 3]) '(1 2 3))) +(Assert (equal (mapcar #'identity #*010) '(0 1 0))) + +(let ((z 0) (list (make-list 1000 1))) + (mapc (lambda (x) (incf z x)) list) + (Assert (eq 1000 z))) + +(Check-Error wrong-type-argument (mapvector #'identity (current-buffer))) +(Assert (equal (mapvector #'identity '(1 2 3)) [1 2 3])) +(Assert (equal (mapvector #'identity "123") [?1 ?2 ?3])) +(Assert (equal (mapvector #'identity [1 2 3]) [1 2 3])) +(Assert (equal (mapvector #'identity #*010) [0 1 0])) + +(Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo")) +(Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3")) +(Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3")) + +;;----------------------------------------------------- +;; Test vector functions +;;----------------------------------------------------- +(Assert (equal [1 2 3] [1 2 3])) +(Assert (equal [] [])) +(Assert (not (equal [1 2 3] []))) +(Assert (not (equal [1 2 3] [1 2 4]))) +(Assert (not (equal [0 2 3] [1 2 3]))) +(Assert (not (equal [1 2 3] [1 2 3 4]))) +(Assert (not (equal [1 2 3 4] [1 2 3]))) +(Assert (equal (vector 1 2 3) [1 2 3])) +(Assert (equal (make-vector 3 1) [1 1 1])) + +;;----------------------------------------------------- +;; Test bit-vector functions +;;----------------------------------------------------- +(Assert (equal #*010 #*010)) +(Assert (equal #* #*)) +(Assert (not (equal #*010 #*011))) +(Assert (not (equal #*010 #*))) +(Assert (not (equal #*110 #*010))) +(Assert (not (equal #*010 #*0100))) +(Assert (not (equal #*0101 #*010))) +(Assert (equal (bit-vector 0 1 0) #*010)) +(Assert (equal (make-bit-vector 3 1) #*111)) +(Assert (equal (make-bit-vector 3 0) #*000)) diff --git a/tests/automated/md5-tests.el b/tests/automated/md5-tests.el new file mode 100644 index 0000000..1ebde76 --- /dev/null +++ b/tests/automated/md5-tests.el @@ -0,0 +1,96 @@ +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic +;; Created: 1998 +;; Keywords: tests + +;; 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 Emacs. + +;;; Commentary: + +;; Test basic md5 functionality. +;; See test-harness.el for instructions on how to run these tests. + +(eval-when-compile + (condition-case nil + (require 'test-harness) + (file-error + (push "." load-path) + (when (and (boundp 'load-file-name) (stringp load-file-name)) + (push (file-name-directory load-file-name) load-path)) + (require 'test-harness)))) + +(defconst md5-tests + '( + ;; Test samples from rfc1321: + ("" . "d41d8cd98f00b204e9800998ecf8427e") + ("a" . "0cc175b9c0f1b6a831c399e269772661") + ("abc" . "900150983cd24fb0d6963f7d28e17f72") + ("message digest" . "f96b697d7cb7938d525a2f31aaf161d0") + ("abcdefghijklmnopqrstuvwxyz" . "c3fcd3d76192e4007dfb496cca67e13b") + ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + . "d174ab98d277d9f5a5611c2c9f419d9f") + ("12345678901234567890123456789012345678901234567890123456789012345678901234567890" + . "57edf4a22be3c955ac49da2e2107b67a"))) + +;;----------------------------------------------------- +;; Test `md5' on strings +;;----------------------------------------------------- + +(mapcar (lambda (x) + (Assert (equal (md5 (car x)) (cdr x)))) + md5-tests) + +;;----------------------------------------------------- +;; Test `md5' on portions of strings +;;----------------------------------------------------- + +(let ((large-string (mapconcat #'car md5-tests ""))) + (let ((count 0)) + (mapcar (lambda (x) + (Assert (equal (md5 large-string count (+ count (length (car x)))) + (cdr x))) + (incf count (length (car x)))) + md5-tests))) + +;;----------------------------------------------------- +;; Test `md5' on buffer +;;----------------------------------------------------- + +(with-temp-buffer + (mapcar (lambda (x) + (erase-buffer) + (insert (car x)) + (Assert (equal (md5 (current-buffer)) (cdr x)))) + md5-tests)) + +;;----------------------------------------------------- +;; Test `md5' on portions of buffer +;;----------------------------------------------------- + +(with-temp-buffer + (insert (mapconcat #'car md5-tests "")) + (let ((point 1)) + (mapcar (lambda (x) + (Assert (equal (md5 (current-buffer) point (+ point (length (car x)))) + (cdr x))) + (incf point (length (car x)))) + md5-tests))) diff --git a/tests/glyph-test.el b/tests/glyph-test.el new file mode 100644 index 0000000..8a61ceb --- /dev/null +++ b/tests/glyph-test.el @@ -0,0 +1,56 @@ +(set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph [xpm :file "../etc/xemacs-icon.xpm"])) + +(defun foo () + (interactive) + (setq ok-select (not ok-select))) + +;; button in a group +(setq ok-select nil) +(set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph [button :descriptor ["ok " (setq ok-select t) + :style radio :selected ok-select]])) +;; button in a group +(set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph [button :descriptor ["ok" (setq ok-select nil) :style radio + :selected (not ok-select)]])) +;; normal pushbutton +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq pbutton (make-glyph [button :width 10 :height 2 + :face modeline-mousable + :descriptor ["ok" foo :selected t]]))) +;; normal pushbutton +(set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph [button :descriptor ["A Big Button" foo ]])) +;; edit box +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq hedit (make-glyph [edit :pixel-width 50 :pixel-height 30 + :face bold-italic + :descriptor ["Hello"]]))) +;; combo box +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq hcombo (make-glyph + [combo :width 10 :height 3 :descriptor ["Hello"] + :properties (:items ("One" "Two" "Three"))]))) + +;; line +(set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph [label :pixel-width 150 :descriptor "Hello"])) + +;; scrollbar +;(set-extent-begin-glyph +; (make-extent (point) (point)) +; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]])) + +;; generic subwindow +(setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 50])) +(set-extent-begin-glyph (make-extent (point) (point)) sw) +