included commits to RCS files with non-trunk default branches.
+1998-12-24 Martin Buchholz <martin@xemacs.org>
+
+ * XEmacs 21.2.7 is released.
+
+1998-12-17 Andy Piper <andy@xemacs.org>
+
+ * 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 <popineau@ese-metz.fr>
+
1998-12-16 Andy Piper <andy@xemacs.org>
* XEmacs 21.2.6 is released
*/
#define NO_SHORTNAMES /* Tell config not to load remap.h */
+#define DONT_ENCAPSULATE
#include <../src/config.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
#include <stdio.h>
#include <errno.h>
+#include "../src/sysfile.h"
#include "../src/syswait.h"
+#ifndef WINDOWSNT
#include "../src/systime.h"
+#endif
#include <stdlib.h>
#include <string.h>
#include "getopt.h"
exit (retcode);
}
+#ifndef WINDOWSNT
setuid (getuid ());
+#endif
#endif /* MAIL_USE_POP */
#ifndef DISABLE_DIRECT_ACCESS
error ("Error in open: %s, %s", strerror (errno), outfile);
return (1);
}
-#ifndef __CYGWIN32__
+#if !defined(__CYGWIN32__) && !defined(WINDOWSNT)
fchown (mbfi, getuid (), -1);
#endif
#include <sys/types.h>
#ifdef WINDOWSNT
-#include "ntlib.h"
#include <winsock.h>
#undef SOCKET_ERROR
#define RECV(s,buf,len,flags) recv(s,buf,len,flags)
#include <sys/stat.h>
#include <sys/file.h>
#include "../src/syswait.h"
+#ifndef WINDOWSNT
#include "../src/systime.h"
+#endif
#include <stdlib.h>
#include <string.h>
username = getenv ("USER");
if (! (username && *username))
{
+#ifndef WINDOWSNT
username = getlogin ();
if (! (username && *username))
{
return (0);
}
}
+#else
+ strcpy (pop_error, "Could not determine username");
+ return (0);
+#endif
}
}
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");
;;; (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 ()
(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")))
;; #### 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...
;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
;; Created: Jan 1998
-;; Version: $Revision: 1.7.2.1 $
+;; Version: $Revision: 1.7.2.2 $
;; Keywords: help comm
;; This file is part of XEmacs
;;; 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.
`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
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
;; 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
(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
(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))
: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."
(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")
(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.")
))
;;;###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.
(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)
(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)
(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)
))
(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")
(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
(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 ()
))
))
-(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 ()
(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
(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)
; (message (substitute-command-keys "Press `\\[pui-help]' for help."))
))
+;;;###autoload
+(defalias 'list-packages 'pui-list-packages)
(provide 'package-ui)
(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)
: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
(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
(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))
+1998-12-24 Martin Buchholz <martin@xemacs.org>
+
+ * XEmacs 21.2.7 is released.
+
1998-12-16 Andy Piper <andy@xemacs.org>
* XEmacs 21.2.6 is released
@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
@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
@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{<package-name>-<version>-pkg.tar.gz}.
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
+1998-12-24 Martin Buchholz <martin@xemacs.org>
+
+ * XEmacs 21.2.7 is released.
+
+1998-12-13 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * 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 <andy@xemacs.org>
+
+ * 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 <andy@xemacs.org>
* XEmacs 21.2.6 is released
** 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
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.
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.
/* 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? */
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
!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.
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 \
# 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)"
@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
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\
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),
}
}
+ {
+ /* 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
/* 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;
#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)
return CONSOLE_TTY_DATA (decode_tty_console (console))->controlling_process;
}
-#ifdef MULE
+#ifdef FILE_CODING
\f
DEFUN ("console-tty-input-coding-system", Fconsole_tty_input_coding_system,
0, 1, 0, /*
Fset_console_tty_output_coding_system (console, codesys);
return Qnil;
}
-#endif /* MULE */
+#endif /* FILE_CODING */
\f
Lisp_Object
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
Lisp_Object device;
Display *display;
#ifdef FREE_CHECKING
- extern void (*__free_hook)();
+ extern void (*__free_hook) (void *);
int checking_free;
#endif
Lisp_Object Qdelete_device;
Lisp_Object Qcreate_device_hook;
Lisp_Object Qdelete_device_hook;
-
Lisp_Object Vdevice_class_list;
\f
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;
}
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;
#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))
{
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);
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) */
#include "lisp.h"
#include "opaque.h"
#include "sysdep.h"
+#include "buffer.h"
#include <errno.h>
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))
{
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;
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 <config.h>
#include "device.h"
#include "events.h"
#include "frame.h"
+#include "buffer.h"
+#include "faces.h"
#include "lstream.h"
#include "process.h"
#include "redisplay.h"
#include "syswait.h"
#include "systime.h"
#include "sysdep.h"
+#include "objects-msw.h"
#include "events-mod.h"
#ifdef HAVE_MSG_SELECT
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);
/* 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()
DEFINE_LSTREAM_IMPLEMENTATION ("ntpipe-output", lstream_ntpipe_shove,
sizeof (struct ntpipe_shove_stream));
+#ifndef HAVE_MSG_SELECT
static DWORD WINAPI
shove_thread (LPVOID vparam)
{
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)
{
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
{
/*
* 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;
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);
return Qnil;
}
\f
+#ifndef HAVE_MSG_SELECT
/************************************************************************/
/* Waitable handles manipulation */
/************************************************************************/
mswindows_waitable_handles [ix] =
mswindows_waitable_handles [--mswindows_waitable_count];
}
+#endif /* HAVE_MSG_SELECT */
\f
/************************************************************************/
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 ();
}
{
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,
{
/* 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;
case WM_COMMAND:
{
WORD id = LOWORD (wParam);
+ WORD nid = HIWORD (wParam);
HWND cid = (HWND)lParam;
frame = XFRAME (mswindows_find_frame (hwnd));
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 */
{
}
}
+#ifndef HAVE_MSG_SELECT
static HANDLE
get_process_input_waitable (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)
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)
{
assert (INTP (Vx));
Vy = Fevent_y_pixel (obj);
assert (INTP (Vy));
- sprintf (buf, "#<motion-event %ld, %ld", (long)(XINT (Vx)), (long)(XINT (Vy)));
+ sprintf (buf, "#<motion-event %ld, %ld", (long) XINT (Vx), (long) XINT (Vy));
write_c_string (buf, printcharfun);
break;
}
#define CHECK_EVENT_TYPE(e,t1,sym) do { \
CHECK_LIVE_EVENT (e); \
if (XEVENT(e)->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, /*
#include "lisp.h"
#include "buffer.h"
+#include "elhash.h"
#include "console-msw.h"
#include "glyphs-msw.h"
#include "elhash.h"
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;
#ifdef HAVE_TOOLBARS
markobj (FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f));
#endif
+ markobj (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f));
}
static void
{
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));
}
}
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))
{
#endif
#include "device.h"
+#include "glyphs.h"
#define FRAME_TYPE_NAME(f) ((f)->framemeths->name)
#define FRAME_TYPE(f) ((f)->framemeths->symbol)
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;
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;
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; \
#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)
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 */
#include <config.h>
#include "lisp.h"
#else
-void *malloc (unsigned long);
+void *malloc (size_t);
#endif
#if !defined(HAVE_LIBMCHECK)
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) ();
}
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;
return result;
}
-extern void *(*__realloc_hook) (void *, unsigned long);
+extern void *(*__realloc_hook) (void *, size_t);
#ifdef MIN
#undef MIN
/* 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;
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)
}
static void *
-block_input_malloc (unsigned long size)
+block_input_malloc (size_t size)
{
void* result;
__free_hook = 0;
static void *
-block_input_realloc (void* ptr, unsigned long size)
+block_input_realloc (void* ptr, size_t size)
{
void* result;
__free_hook = 0;
}
#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) */
Lisp_Object Qreverse;
Lisp_Object Qright;
Lisp_Object Qsearch;
+Lisp_Object Qselected;
Lisp_Object Qsignal;
Lisp_Object Qsimple;
Lisp_Object Qsize;
Lisp_Object Qwarning;
Lisp_Object Qwhite;
Lisp_Object Qwidth;
+Lisp_Object Qwidget;
Lisp_Object Qwindow;
Lisp_Object Qwindow_system;
Lisp_Object Qx;
defsymbol (&Qreverse, "reverse");
defsymbol (&Qright, "right");
defsymbol (&Qsearch, "search");
+ defsymbol (&Qselected, "selected");
defsymbol (&Qsignal, "signal");
defsymbol (&Qsimple, "simple");
defsymbol (&Qsize, "size");
defsymbol (&Qwarning, "warning");
defsymbol (&Qwhite, "white");
defsymbol (&Qwidth, "width");
+ defsymbol (&Qwidget, "widget");
defsymbol (&Qwindow, "window");
defsymbol (&Qwindow_system, "window-system");
defsymbol (&Qx, "x");
-/* mswindows-specific Lisp objects.
+/* mswindows-specific glyph objects.
Copyright (C) 1998 Andy Piper.
This file is part of XEmacs.
/* Synched up with: Not in FSF. */
-/* written by Andy Piper <andyp@parallax.co.uk> plagerising buts from
+/* written by Andy Piper <andy@xemacs.org> plagerising bits from
glyphs-x.c */
#include <config.h>
#include "glyphs-msw.h"
#include "objects-msw.h"
+#include "window.h"
+#include "elhash.h"
#include "buffer.h"
#include "frame.h"
#include "insdel.h"
#include <stdio.h>
#include <ctype.h>
+#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;
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);
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);
}
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;
/* 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))
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,
}
write_c_string (")", printcharfun);
break;
+
default:
break;
}
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
!= IMAGE_INSTANCE_MSWINDOWS_BITMAP (p2))
return 0;
break;
+
default:
break;
}
case IMAGE_COLOR_PIXMAP:
case IMAGE_POINTER:
return (unsigned long) IMAGE_INSTANCE_MSWINDOWS_BITMAP (p);
+
default:
return 0;
}
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;
\f
/************************************************************************/
+/* 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;
+}
+
+\f
+/************************************************************************/
/* initialization */
/************************************************************************/
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");
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
/* 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.
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_ */
--- /dev/null
+/* 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 <config.h>
+#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);
+}
+
+\f
+/************************************************************************/
+/* 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)
+{
+}
#include "xmu.h"
#include "buffer.h"
+#include "window.h"
#include "frame.h"
#include "insdel.h"
#include "opaque.h"
#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;
}
write_c_string (")", printcharfun);
break;
-#if HAVE_SUBWINDOWS
- case IMAGE_SUBWINDOW:
- /* #### implement me */
-#endif
default:
break;
}
{
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))
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;
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;
}
}
\f
-#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 #<subwindow 0x%x>",
- sw->header.uid);
-
- write_c_string ("#<subwindow", printcharfun);
- sprintf (buf, " %dx%d", sw->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);
-\f
-/* #### 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.
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
\f
/************************************************************************/
/* initialization */
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
}
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");
#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_ */
#define _XEMACS_GLYPHS_H_
#include "specifier.h"
+#include "gui.h"
/************************************************************************/
/* Image Instantiators */
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
{
Lisp_Object symbol;
+ Lisp_Object device; /* sometimes used */
+
ii_keyword_entry_dynarr *keywords;
/* Implementation specific 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 *****/
#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 */
#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. */
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,
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));
IMAGE_MONO_PIXMAP,
IMAGE_COLOR_PIXMAP,
IMAGE_POINTER,
- IMAGE_SUBWINDOW
+ IMAGE_SUBWINDOW,
+ IMAGE_WIDGET
};
#define IMAGE_NOTHING_MASK (1 << 0)
#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)
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); \
#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;
} 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;
#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) \
#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);
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;
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 */
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);
/* 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_ */
--- /dev/null
+/* 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 <config.h>
+#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;
+}
+
#include <config.h>
#include "lisp.h"
#include "gui.h"
+#include "elhash.h"
#include "bytecode.h"
Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected;
{
return popup_up_p ? Qt : Qnil;
}
+#endif /* HAVE_POPUPS */
int
separator_string_p (CONST char *s)
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 */
/* 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++];
}
/*
+ * 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
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
/* 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)
#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 *);
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_ */
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)
{
{
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))
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))
#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;
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, /*
#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;
#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;
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);
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);
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;
(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))
--- /dev/null
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Hrvoje Niksic <hniksic@srce.hr>
+;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+;; 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)))
--- /dev/null
+(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)
+
projects / chise / xemacs-chise.git / commitdiff